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

[WIsh_]

Bonjour à tous,

Je cherche comment copier dans mon classeur "fichier0.xlsx", les données présentes dans deux classeurs "fichier1.xlsx" et "fichier2.xlsx" qui sont ouverts dans une autre instances d'Excel.

Si ce n'est pas possible, je cherche comment fermer ces deux fichiers à partir de la 1ère instance, pour ensuite les ouvrir dans la 1ère instance.

Je ne peux pas influer sur le fait que fichier1 et fichier 2 s'ouvrent dans une autre instance (pas accès à la configuration du programme à partir duquel ces fichiers sont extraits).

J'ai cherché pas mal sur ce forum et d'autres. On parle souvent d'ouvrir une autre instance mais jamais de la fermer.

Merci d'avance pour vos idées,
Wish

 

[kiki29]

Salut, Ce lien n'existe plus ?

 

[WIsh_]

Bonjour Kiki,

J'ai en effet trouvé ce code mais je n'arrive pas à m'en servir. Excel me renvoie l'erreur "Error 438(Propriété ou méthode non gérée pa rcet objet) in procedure CloseAllotherExcel"

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

 

[WIsh_]

J'ai aussi essayé ce code mais il ne me renvoie rien. Il devrait me renvoyer l'UID du processus si j'ai bien suivi. Quand je fais le pas à pas détaillé, ça boucle non stop.

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

Je sens que la réponse n'est pas loin mais je cale depuis 2 jours. Enfin comme d'hab quoi

 

[patricktoulon]

bonsoir
allons donc
test ceci et regarde dans la fenêtre d’exécution je pense que ça devrait t’éclairer pour la marche a suivre

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

GetAllInstanceExceL devient un tableau d'object application excel
il est facile apres de lister les classeurs dans chaque intance de l'application
tu pourra donc récupérer ,modifier,etc.. ou fermer soit le classeur d'une instance soit fermer l'intance et tout ses classeurs ouvert

je fourni les aspro sur demandes

 

[WIsh_]

Bonjour @patricktoulon,

Merci pour ta réponse et mes excuses pour mon retour très très tardif.
(La famille s'est agrandie et je suis resté éloigné du PC pendant presque 3 mois).

Je n'ai pas réussi à mettre en pratique ta solution... pas assez doué.

J'ai contourné le problème en fermant les fichiers ouverts dans l'autre instance, puis en les ouvrant. En les ouvrant, ils s'ouvrent dans la même application que celle de mon fichier principal avec ma macro.

Pour les fermer :

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

Merci en tout cas pour ta réponse,
Bien cordialement,

Wish