XL 2016 Fermer Fichier si ouvert

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

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

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