XL 2013 VBA - Enregistrer un fichier ouvert sur une autre instance Excel

[pipochicoin]

Bonjour à tous,

Je rencontre un problème assez simple : une application tierce (un ERP) construit des fichiers Excel et les ouvre. Je souhaite pouvoir les enregistrer via une macro.

Le problème est qu'à chaque création de fichier, celui ci est ouvert dans une nouvelle instance d'Excel, et que je ne parviens pas à l'atteindre pour l'enregistrer via les fonctions habituelles (Workbooks.save)

De mes recherches je vu que pour contourner la séparation d'instances je pouvais utiliser les fonctions GetObject... J'ai essayé sans grand succès, mais le fichier n'étant pas enregistré, celui-ci n'a pas de nom, ni d’extension, ni de répertoire d'accès.

Le point discriminant est que les fichiers s'ouvrent selon la dénomination "Classeur1", puis "Classeur 2", etc... (nom dans la barre de titre de l'application).

J'ai un point de départ de code, me permettant de compter les instances excel ouvertes simultanément.
Je pensais pouvoir me baser sur des objlist(i).Application.Workbooks pour pointer sur ces classeurs, mais sans réussite (Erreur d'exécution '2147217407 (80041001)' / Echec Générique")

Je ne suis pas certain de bien exploiter ces fonctions, l’un d'entre vous pourrait il me permettre d'atteindre ces fameux classeurs ?

Merci d'avance pour votre aide... ci dessous le début du code que je ne parviens plus à faire progresser

Sub test()

Dim strComputer As String
Dim objWMIService As Object
Dim objProcess As Object
Dim objList As Object
Dim appexcel As Excel.Application
'Set objApp = objList.Application
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & _
    "{impersonationLevel=impersonate}!\\" & _
    strComputer & "\root\cimv2")
Set objList = objWMIService.execquery("select * from win32_process where name='EXCEL.EXE'")


MsgBox "Nombre d'instances : " & objList.Count
For i = 1 To objList.Count
Set appexcel = objList(1).Application
classeur = appexcel.Workbooks(1)

Next i
Set objWMIService = Nothing
Set objList = Nothing
Set objProcess = Nothing

End Sub

 

[bérylion]

salut

difficile, mais pas impossible... courage !

j'ai essayé une autre approche, qui récupère la 1ere instance d'excel en haut de la pile (ou la dernière activée, tout dépend ou on se place par rapport à l'idée qu'on s'en fait), et qui enregistre le classeur MonClasseuri.xslx sur le bureau :

Option Explicit

Private Type GUID
    lData1 As Long
    iData2 As Integer
    iData3 As Integer
    aBData4(0 To 7) As Byte
End Type

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 Sub AccessibleObjectFromWindow Lib "OLEACC.DLL" _
  (ByVal hwnd As Long, ByVal dwId As Long, riid As GUID, ppvObject As Any)

Private Const OBJID_NATIVEOM = &HFFFFFFF0

Private Sub SetIDispatch(ByRef ID As GUID)
    ' IDispatch Interface.
    ' {00020400-0000-0000-C000-000000000046}.
    With ID
        .lData1 = &H20400
        .iData2 = &H0
        .iData3 = &H0
        .aBData4(0) = &HC0
        .aBData4(1) = &H0
        .aBData4(2) = &H0
        .aBData4(3) = &H0
        .aBData4(4) = &H0
        .aBData4(5) = &H0
        .aBData4(6) = &H0
        .aBData4(7) = &H46
    End With
End Sub

Public Function ApplicationFromHwnd() As Application
    Dim IDispatch As GUID
    Dim oWB As Object
    Dim lXLhwnd As Long
    Dim lXLDESKhwnd As Long
    Dim lWBhwnd As Long
    Do
        lXLhwnd = FindWindowEx(0, lXLhwnd, "XLMAIN", vbNullString)
        If lXLhwnd = 0 Then
            Exit Do
        ElseIf lXLhwnd <> Application.hwnd Then
            lXLDESKhwnd = FindWindowEx(lXLhwnd, 0&, "XLDESK", vbNullString)
            lWBhwnd = FindWindowEx(lXLDESKhwnd, 0&, "EXCEL7", vbNullString)
            If lWBhwnd Then
                SetIDispatch IDispatch
                Call AccessibleObjectFromWindow _
                (lWBhwnd, OBJID_NATIVEOM, IDispatch, oWB)
                Set ApplicationFromHwnd = oWB.Application
                Exit Do
            End If
        End If
    Loop
    Set oWB = Nothing
End Function

Private Function MonBureau$()
  Dim WshShell As Object
  Set WshShell = CreateObject("WScript.Shell")
  MonBureau = WshShell.SpecialFolders.Item(4) & "\"
  Set WshShell = Nothing
End Function

Sub enregistrer_classeurX()
'Rem pour faire un test, _
  décommenter la commande suivante pour créer un fichier vide :

    'Shell "excel.exe"
    Static i%
    Dim oXLApp As Object, Filename$
    i = i + 1
    Filename$ = MonBureau & "MonClasseur" & i & ".xlsx"
  
    Set oXLApp = ApplicationFromHwnd()
  
    With oXLApp
      .ActiveWorkbook.SaveAs (Filename)
      .Quit
    End With
  
End Sub

[testé sous xl2010 win7 (pro-32) sans problèmes]

en appelant la macro enregistrer_classeurX , tu récupères la derniere instance activée et tu enregistres le classeur en ayant préalablement défini là ou tu veux le ranger (dans mon exmple, en vrac sur le bureau), et tu fermes l'instance.
tu peux meme completer le nom d'enregistrement en remplacement la variable i par un compteur type FileSystemObject qui te dira combien de fichiers sont déja dans ton dossier, ça simplifie, et ca evite les erreurs...

à toi d'adapter suivant ton besoin !...

enjoy