XL 2016 Fermer Fichier si ouvert

  • Initiateur de la discussion Initiateur de la discussion KTM
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

KTM

XLDnaute Impliqué
Salut chers tous
Ma macro suivante exporte ma plage au format pdf en lui donnant le nom "Liste.pdf"
Quand Liste.pdf est fermé il est écrasé pas de soucis
Mais quand il est déjà ouvert j'ai une erreur.
Je voudrais insérer dans ma macro un code pour fermer Liste.pdf si ouvert avant de l’écraser. Merci

VB:
Sub export()
Dim chemin, NomPDF As String
    chemin = ThisWorkbook.Path & "\PREVUS\"
    If Dir(chemin, vbDirectory) = "" Then MkDir chemin
With ActiveSheet
    NomPDF = "Liste"
    .PageSetup.PrintArea = "$A$1:$I$50"
    .PageSetup.FitToPagesWide = 1
    .PageSetup.FitToPagesTall = False
    .PageSetup.RightFooter = "&P de &N"
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & NomPDF, Quality:=xlQualityStandard
End With
End Sub
 
Bonsoir @KTM, le Forum

Juste une question, ouvert par toi ? ou par quelqu'un dans le réseau ?

Si c'est que sur ta propre session, il faut faire un loop sur les ActiveWindows je pense..
Si c'est en réseau je ne vois pas de solution mis à part d'envoyer du NetSend "Fermer le fichier liste.pdf !!!" ou un mail ... Mais tout dépend des régles de sécurité de ton NetWork Admin..

Bonne soirée
@+Thierry
 
Salut, dans le genre brutal et bestial, à affiner
VB:
Option Explicit

Sub export()
Dim sChemin As String, sNomPDF As String
Dim FSO As Object

    sChemin = ThisWorkbook.Path
    sNomPDF = "Liste.pdf"
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FileExists(sChemin & "\" & sNomPDF) Then
        If IsFileOpen(sChemin & "\" & sNomPDF) Then
            KillAcrobat
        End If
        Set FSO = Nothing
    End If

    With ActiveSheet
        .PageSetup.PrintArea = "$A$1:$I$50"
        .PageSetup.FitToPagesWide = 1
        .PageSetup.FitToPagesTall = False
        .PageSetup.RightFooter = "&P de &N"
        .ExportAsFixedFormat Type:=xlTypePDF, _
                             filename:=sChemin & "\" & sNomPDF, _
                             Quality:=xlQualityStandard, _
                             OpenAfterPublish:=True
    End With
End Sub

Private Function IsFileOpen(filename As String)
Dim filenum As Integer, errnum As Integer
    '   Turn error checking Off.
    On Error Resume Next
    filenum = FreeFile()

    Open filename For Input Lock Read As #filenum
    Close filenum
    '   Save the error number that occurred.
    errnum = Err
    '   Turn error checking back On.
    On Error GoTo 0

    Select Case errnum
        '   No error occurred.
        '   File is NOT already open by another user.
    Case 0
        IsFileOpen = False
        '   Error number for "Permission Denied."
        '   File is already opened by another user.
    Case 70
        IsFileOpen = True
        '   Another error occurred, file is being queried.
    Case Else
        Error errnum
    End Select
End Function

Private Sub KillAcroRd32()
Dim RetVal As Long
    RetVal = Shell("Taskkill /im AcroRd32.exe /t /f", 0)
End Sub

Private Sub KillAcrobat()
Dim RetVal As Long
    RetVal = Shell("Taskkill /im Acrobat.exe /f", 0)
End Sub

une autre plus douce à adapter
Code:
Option Explicit

Sub export()
Dim sChemin As String, sNomPDF As String
Dim FSO As Object

    sChemin = ThisWorkbook.Path
    sNomPDF = "Liste.pdf"

    sNomPDF = RenommerFichier(sChemin, sNomPDF)
    With ActiveSheet
        .PageSetup.PrintArea = "$A$1:$I$50"
        .PageSetup.FitToPagesWide = 1
        .PageSetup.FitToPagesTall = False
        .PageSetup.RightFooter = "&P de &N"
        .ExportAsFixedFormat Type:=xlTypePDF, _
                             filename:=sNomPDF, _
                             Quality:=xlQualityStandard, _
                             OpenAfterPublish:=True
    End With
End Sub

Private Function RenommerFichier(sDossier As String, sNomfichier As String) As String
Dim sNouveauNom As String
Dim sPre As String, sExt As String
Dim i As Long
Dim FSO As Object

    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FileExists(sDossier & "\" & sNomfichier) Then
        sNouveauNom = sNomfichier
        sPre = FSO.GetBaseName(sNomfichier)
        sExt = FSO.GetExtensionName(sNomfichier)

        i = 0
        While FSO.FileExists(sDossier & "\" & sNouveauNom)
            i = i + 1
            sNouveauNom = sPre & Chr(40) & Format(i, "000") & Chr(41) & Chr(46) & sExt
        Wend
        sNomfichier = sNouveauNom
    End If
    Set FSO = Nothing

    RenommerFichier = sDossier & "\" & sNomfichier
End Function
 
Dernière édition:
Bonsoir à tous

KTM n'a pas répondu si c'était en réseau ou pas, car c'est important.

Pour Job, même avec le même nom il te laisse écraser un PDF ouvert même avec Excel 2019 ca me parait bizarre ...

Pour kiki, oui donc à deux conditions, ouvert par KTM lui même sur sa session, et ouvert avec Acrobat Reader (pas avec d'autres freeware "Foxit", "Slim", "Nitro", "Expert" et "Jean" Passe ...😉

Bonne soirée
@+Thierry
 
Re, moins assassine
VB:
Option Explicit

Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
                                     (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
                                      lParam As Any) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
                                    (ByVal lpClassname As String, ByVal lpWindowName As String) As Long

Private Const WM_CLOSE = &H10

Sub Test()
Dim Hwnd As Long

    Hwnd = FindWindow(vbNullString, "Liste.pdf - Adobe Acrobat Reader DC")

    If Hwnd Then PostMessage Hwnd, WM_CLOSE, 0, ByVal 0&
End Sub
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
13
Affichages
847
Réponses
2
Affichages
722
Réponses
4
Affichages
680
Réponses
6
Affichages
1 K
Réponses
7
Affichages
937
Réponses
6
Affichages
1 K
Réponses
5
Affichages
1 K
Réponses
12
Affichages
1 K
Retour