XL 2013 Fermer la seconde instance d'excel à partir de la première

Public Sub CloseAllOtherExcel()
    Dim objExcel As Object
    Dim lngMyHandle As Long
    Dim strMsg As String

On Error GoTo ErrorHandler
    lngMyHandle = Application.hWndAccessApp

    Set objExcel = GetObject(, "Excel.Application")
    Do While TypeName(objExcel) = "Application"
        If objExcel.hWndExcelApp <> lngMyHandle Then
            Debug.Print "found another Excel instance: " & _
                objExcel.hWndExcelApp
            objExcel.Quit acQuitSaveNone
        Else
            Debug.Print "found myself"
            Exit Do
        End If
        Set objExcel = GetObject(, "Excel.Application")
    Loop

ExitHere:
    Set objExcel = Nothing
    On Error GoTo 0
    Exit Sub

ErrorHandler:
    strMsg = "Error " & Err.Number & " (" & Err.Description _
        & ") in procedure CloseAllOtherExcel"
    MsgBox strMsg
    GoTo ExitHere
End Sub

Declare Function FindWindowEx Lib "User32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Declare Function GetClassName Lib "User32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, ByRef lpiid As UUID) As Long
Declare Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hWnd As Long, ByVal dwId As Long, ByRef riid As UUID, ByRef ppvObject As Object) As Long

Type UUID 'GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
Const OBJID_NATIVEOM As Long = &HFFFFFFF0

Sub ListAll()
    Dim I As Integer
    Dim hWndMain As Long
    On Error GoTo MyErrorHandler
        hWndMain = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)
        I = 1
        Do While hWndMain <> 0
            Debug.Print "Excel Instance " & I
            GetWbkWindows hWndMain
            hWndMain = FindWindowEx(0&, hWndMain, "XLMAIN", vbNullString)
            I = I + 1
        Loop
        Exit Sub
MyErrorHandler:
    MsgBox "GetAllWorkbookWindowNames" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Sub

Sub GetWbkWindows(ByVal hWndMain As Long)
    Dim hWndDesk As Long
    Dim hWnd As Long
    Dim strText As String
    Dim lngRet As Long
    On Error GoTo MyErrorHandler
        hWndDesk = FindWindowEx(hWndMain, 0&, "XLDESK", vbNullString)
        If hWndDesk <> 0 Then
            hWnd = FindWindowEx(hWndDesk, 0, vbNullString, vbNullString)
            Do While hWnd <> 0
                strText = String$(100, Chr$(0))
                lngRet = GetClassName(hWnd, strText, 100)
                If Left$(strText, lngRet) = "EXCEL7" Then
                    GetExcelObjectFromHwnd hWnd
                    Exit Sub
                End If
                hWnd = FindWindowEx(hWndDesk, hWnd, vbNullString, vbNullString)
            Loop
            On Error Resume Next
        End If
            Exit Sub
MyErrorHandler:
        MsgBox "GetWbkWindows" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Sub

Function GetExcelObjectFromHwnd(ByVal hWnd As Long) As Boolean
    Dim fOk As Boolean
    Dim I As Integer
    Dim obj As Object
    Dim iid As UUID
    Dim objApp As Excel.Application
    Dim myWorksheet As Worksheet
    On Error GoTo MyErrorHandler
        fOk = False
        Call IIDFromString(StrPtr(IID_IDispatch), iid)
        If AccessibleObjectFromWindow(hWnd, OBJID_NATIVEOM, iid, obj) = 0 Then 'S_OK
            Set objApp = obj.Application
            For I = 1 To objApp.Workbooks.Count
                Debug.Print "     " & objApp.Workbooks(I).Name
                For Each myWorksheet In objApp.Workbooks(I).Worksheets
                    Debug.Print "          " & myWorksheet.Name
                    DoEvents
                Next
                fOk = True
            Next I
        End If
        GetExcelObjectFromHwnd = fOk
        Exit Function
MyErrorHandler:
        MsgBox "GetExcelObjectFromHwnd" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Function

Option Explicit
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, ByRef lpiid As GUID) As Long
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hwnd As Long, ByVal dwId As Long, ByRef riid As GUID, ByRef ppvObject As Object) As Long

Private Type GUID: Data1 As Long: Data2 As Integer: Data3 As Integer: Data4(7) As Byte: End Type

Private Const RETURN_OK As Long = &H0
Private Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
Private Const OBJID_NATIVEOM As Long = &HFFFFFFF0


Function GetAllInstanceExceL()
    Dim x, hWinDesk&, hWin7&, hWndXL&, Tablexcel() As Variant, oWB As Object, oWS As Object, obj As Object, iID As GUID, oXLApp As Object
    hWndXL = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)    'trouve le premier handle excel
    Do While hWndXL > 0    'boucle jusqu'a que ""hWndXL"" retourne "0"!!
        x = x + 1    '// Incrementation de la variable x
        hWinDesk = FindWindowEx(hWndXL, 0&, "XLDESK", vbNullString)    'on descend d'un enfant de "XLMAIN"
        hWin7 = FindWindowEx(hWinDesk, 0&, "EXCEL7", vbNullString)    'on descend au petit fils de "XLMAIN"
        'Debug.Print "Instance #" & x & ": "; "Handle: " & hWndXL    '/juste Pour control provisoire affichage dans la fenetre d'execution
        Call IIDFromString(StrPtr(IID_IDispatch), iID)    'construction de "IID" avec le clisd(IID_IDispatch)pour lecture des propriété de la fenetre correspondant au handle
        If AccessibleObjectFromWindow(hWin7, OBJID_NATIVEOM, iID, obj) = RETURN_OK Then ReDim Preserve Tablexcel(1 To x): Set Tablexcel(x) = obj.Application    ' test dispo d'assecibilité de la fenetre :"obj" retourne un object


        hWndXL = FindWindowEx(0, hWndXL, "XLMAIN", vbNullString)
     
    Loop
    GetAllInstanceExceL = Tablexcel
End Function

Sub test()
    Dim instances, wb As Workbook, i, YBoAddin As AddIn
    instances = GetAllInstanceExceL
    For i = 1 To UBound(instances)
        For Each wb In instances(i).Workbooks
            Debug.Print "instance : " & i & "  " & wb.Name
            For Each YBoAddin In wb.Parent.Application.AddIns
                Debug.Print "instance : " & i & "  " & YBoAddin.Name
            Next
            Debug.Print "-------------------------------"
        Next
    Next
End Sub

Private Sub close2()

Dim xlAppBis As Excel.Application

Application.ScreenUpdating = False

Set xlAppBis = GetObject("\\chemin\nom1.XLSX").Application
xlAppBis.Workbooks("nom1.XLSX").Close
xlAppBis.Workbooks("nom2.XLSX").Close
xlAppBis.Workbooks("nom3.XLSX").Close
xlAppBis.Workbooks("nom4.XLSX").Close
Application.DisplayAlerts = False
xlAppBis.Quit
Application.DisplayAlerts = False
Application.ScreenUpdating = True
End Sub