Récupération des macros dans un classeur corrompu

MichelXld

XLDnaute Barbatruc
bonsoir à toutes et à tous


je suis à la recherche de personnes disponibles pour tester la procédure ci joint.
(Excel et Open Office doivent être installés sur le poste)


Le sujet:
Lorsqu'un classeur est corrompu, Il parfois possible d'en récupérer les données en l'ouvrant depuis la suite bureautique Open Office. Les macros sont aussi récupérables.
Open office stocke tous les modules (standards et objets) mais chaque ligne est précédée de l'instruction REM.

La macro Excel ci dessous automatise le processus de récupération et de remise en forme.


Description:
1. Lancez la macro.
2. Sélectionnez le classeur qui vous pose problème (ou un classeur de test) dans la boite de dialogue.
3. Le classeur sélectionné va être ouvert dans Open Office
4. La procedure va créer un nouveau classeur.
5. Ensuite la macro boucle sur tous les modules du document scanné.
6. Des modules sont créés dans le nouveau classeur Excel afin d'importer les macros: (Les procédures evenementielles sont également importées dans des modules).
7. La procédure supprime toutes les instructions REM et remet en forme les modules
8. Open Office est refermé


Les procédures des UserForm sont aussi récupérées mais pas l'objet en lui même. (Ce n'est qu'un moindre mal s'il ne vous reste que les contrôles à repositionner dans la
forme.)



Code:
Option Explicit
Option Compare Text
 
Sub MacrosRecovery_Excel_OOo()
    '
    'MichelXld le 27.08.2006
    'macro testée avec Excel2002 et OOo 2.0.1
    '
    Dim serviceManager As Object, Desktop As Object
    Dim Document As Object
    Dim Fichier As String, Cible As String
    Dim Args()
    Dim Tableau()
    Dim I As Integer, x As Integer, J As Integer
    Dim Wb As Workbook
    Dim VBComp As Object
    Dim v As Integer, y As Integer
 
    'Boîte de dialogue pour sélectionner un classeur
    Fichier = _
    Application.GetOpenFilename("Classeurs Excel (*.xls), *.xls")
    If Fichier = "Faux" Then Exit Sub
    'Transforme le chemin du classeur au format URL
    Fichier = ConvertToURL(Fichier)
    'Création d'une instance Open Office
    Set serviceManager = CreateObject("com.sun.star.serviceManager")
    Set Desktop = _
    serviceManager.createInstance("com.sun.star.frame.Desktop")
   'Ouverture du fichier
    Set Document = _
    Desktop.loadComponentFromURL(Fichier, "_blank", 0, Args)
    'Récupère la liste des noms de modules dans un tableau.
    Tableau() = _
    Document.BasicLibraries.getByName("Standard").ElementNames
 
    'Création d'un nouveau classeur
    'qui va récupérer les macros importées.
    Set Wb = Workbooks.Add
 
    '------------------------
    'Boucle sur les noms de module pour en extraire le contenu
    For I = 0 To UBound(Tableau())
 
        'Crée des modules standard dans le nouveau classeur
        'afin de stocker les macros importées.
        '1= Module standard
        Set VBComp = Wb.VBProject.VBComponents.Add(1)
        'Renomme le module
        VBComp.Name = "Recup" & Tableau(I)
 
        'Insertion des procédures dans les modules
        With Wb.VBProject.VBComponents("Recup" & Tableau(I)).CodeModule
 
            'Fait le ménage: Suppression d'"Option Explicit"
            .DeleteLines 1, .CountOfLines
 
        'Import de la procédure et remise en forme dans le module
        .AddFromString _
        Document.BasicLibraries.getByName("Standard"). _
                getByName(Tableau(I))
 
            For J = .CountOfLines To 1 Step -1
                Cible = .Lines(J, 1)
 
                If Left(Cible, 17) = "Rem Attribute VBA" Then
                .DeleteLines J, 1
                Else
 
                    If Left(Cible, 3) = "Rem" Then
                        Cible = Mid(Cible, 4)
                        .ReplaceLine J, Cible
                        Else
                        .DeleteLines J, 1
                    End If
 
                End If
            Next J
        End With
 
        'Suppression des modules vides
        If VBComp.Type = 1 Then
            v = VBComp.CodeModule.CountOfDeclarationLines + 1
            y = VBComp.CodeModule.CountOfLines
            If y < v Then Wb.VBProject.VBComponents.Remove VBComp
        End If
    Next I
    DoEvents
    'Fermeture du document OOo
    Document.Close (False)
End Sub
 
Function ConvertToURL(Fichier As String)
    'fonction de conversion  au format URL
    Dim Cible As String
 
        Cible = Fichier
        Cible = Replace(Cible, "\", "/")
        ConvertToURL = "[URL="file:///"]file:///[/URL]" & Cible
End Function


actuellement testé avec Excel2002, WinXP & OOo2.0.1


Les amélorations à venir:
Pouvoir placer chaque procédure dans le type de module identique au classeur scanné: module standard, module de classe, modules objets (Feuilles, ThisWorkbook et UserForm)

Remarque:
Une autre solution pourrait consister à ouvrir le classeur dans OpenOffice et le réenregistrer au format .xls, vous permettant de récupérer aussi le contenu des feuilles.



en espérant que vous n'ayez jamais besoin de vous en servir réellement..;o)
bonne soiree
MichelXld
 
Dernière édition:

Celeda

XLDnaute Barbatruc
Re : Récupération des macros dans un classeur corrompu

Bonjour,

mimi, je vais la tester ce soir (je suis équipée comme toi Excel2002 VE...)

mais j'ai une question (sorry si elle n'est pas très futée)

je suis arrêtée au km 3 :


3. Le classeur sélectionné va être ouvert dans Open Office

???

tu veux dire que même si c'est excel qui est prioritaire dans mon pc, l'appli avec laquelle j'ouvre tout le temps mes fichiers, c'est OO qui va prendre le dessus avec le code ?

donc retour en arrière Km1 :


je lance la macro une fois excel ouvert ?

je selectionne un classeur bidon (en ayant placé des modules avec des codes)

et là au Km3, c'est OO qui s'ouvre ?

désolée de t'embêter avec ces manips basiques, mais moi volontaire mais pas très douée :D

??
 

michel_m

XLDnaute Accro
Re : Récupération des macros dans un classeur corrompu

Bonjour, mon cher Michel, le forum

Tout d'abord, félicitations

Résultat:
Testé avec excel2000/winXP et Ooo 2.0 avec classeur test non corrompu comportant 2 modules et 2 modulesfeuilles

Aucun problème : pas de traces de « rem » , je n’ai pas vérifié ligne par ligne la récup du code initial
Les macros événementielles se retrouvent dans des modules classiques sous les noms recupfeuil X

Pas de récup des feuilles Excel (ce n’était pas le but, ok)

En espèrant que cela t'aidera

Amicalement
 

MichelXld

XLDnaute Barbatruc
Re : Récupération des macros dans un classeur corrompu

bonjour à vous

merci cher Michel pour tes commentaires et le temps passé à tester: c'est parfait


chère Celeda, ...;o)

3. Le classeur sélectionné va être ouvert dans Open Office
???
tu veux dire que même si c'est excel qui est prioritaire dans mon pc, l'appli avec laquelle j'ouvre tout le temps mes fichiers, c'est OO qui va prendre le dessus avec le code?

oui le classeur sélectionné va s'ouvrir dans open Office

donc retour en arrière Km1 :
je lance la macro une fois excel ouvert?
je selectionne un classeur bidon (en ayant placé des modules avec des codes)
et là au Km3, c'est OO qui s'ouvre ?

Tu places la macro dans un classeur Excel quelconque
Tu lances la macro
La boite de dialogue "Ouvrir" s'affiche
Tu selectionnes un classeur de test (qui doit etre fermé)
La procédure force l'ouverture dans OOo afin de récupérer le contenu des modules standards et objets


j'espere que ces infos auront répondu à ta demande


bonne journée
MichelXld
 

Celeda

XLDnaute Barbatruc
Re : Récupération des macros dans un classeur corrompu

Bonjour,

Mais oui mon cher mimi, et je testerai donc ce soir.

mais heureusement que tu as des gars comme Michel_M plus averti que moi.

Kissssssssssss les Michel!
 

CB60

XLDnaute Barbatruc
Re : Récupération des macros dans un classeur corrompu

Bonsoir à Tous

J'ai testé la macro ( sous excel 2003 )qui fonctionne et qui me récupere bien les macros,
mais le classeur m'indique une erreur.
Je la joint à ce post.
Bruno
 

Pièces jointes

  • essai michel.xls
    24.5 KB · Affichages: 113

MichelXld

XLDnaute Barbatruc
Re : Récupération des macros dans un classeur corrompu

bonsoir bruno

merci pour ce retour d'information

Peux tu préciser à quel moment survient ce message?

Le message s'affiche dans le classeur qui est ouvert par l'intermédiaire d'OpenOffice?
dans ce cas, y a t'il des liaisons dans ce classeur?

ou

Est ce que le message s'affiche dans le nouveau classeur créé?


bonne soirée
MichelXld
 

Celeda

XLDnaute Barbatruc
Re : Récupération des macros dans un classeur corrompu

Bonjour,

bon alors chose promise chose due :

hé tu sais pas mimi, les michel et le Bruno

et bien du premier coup cela a marché et j'ai réussi !!!

j'ai donc récupéré toutes les procédures dans un book vierge!!

super ton truc mimi

et si je puis me permettre, cela va plus vite que de faire des copier coller
des modules : par exemple, moi qui me sers de certains modules de nos appli,
plutôt que les faire glisser, je peux exporter tous les modules d'un seul coup
virer ceux qui ne m'interessent pas et hop on a tout !

bon tu as vraiment mérité un gros poutoune sur le couvercle.:eek:

Nota: j'ai testé avec DEH et pendant une fraction de seconde j'ai vu le champignon dans oo s'immobiliser, puis disparaître, ce que je n'avais pas eu avec les autres fichiers, peut-être en raison des multiples usf dans l'appli.
 

ChTi160

XLDnaute Barbatruc
Re : Récupération des macros dans un classeur corrompu

Salut Michel
bonsoir Marie,michel,CB60

je viens de tester ce qui va je pense,en interresser plus d'un et cela sans problème avec un fichier de notre cher @+Thierry non corrompu lol

impeccable ,tu te souviens peut être que j'ai connu il y a quelques mois cette mésaventure et que grâce à tes conseils j'ai pu via Oo récupérer mon travail (mes macros )
donc je te remercie
c'est un outil très pratique et il est bon de savoir qu'on le possède lol ca évitera les sueurs froides à pas mal lol
encore merci Michel :p
testé WinXp Excel 2OO2, Oo 2.0
 

CB60

XLDnaute Barbatruc
Re : Récupération des macros dans un classeur corrompu

re bonsoir les Michelsssss,Celeda et chti.
Je viens m'escuser de mon ignorance car le probléme que j'ai signalé tout à l'heure était du à un autre fichier qui me perturbé.
J'ai donc refais le test et le travail réalisé et une pure merveille qui fonctionne très bien.
Merci Michel
Bruno
 

MichelXld

XLDnaute Barbatruc
Re : Récupération des macros dans un classeur corrompu

rebonsoir

Ok bruno...;o)...bonne nouvelle


bonsoir cher Jean-Marie, Oui je m'en souviens tres bien : et ce nouveau projet en est partiellement issu ( je n'avais pas eu le temps de m'y atteler jusqu'à présent)


ma chère Celeda

et si je puis me permettre, cela va plus vite que de faire des copier coller
des modules : par exemple, moi qui me sers de certains modules de nos appli,
plutôt que les faire glisser, je peux exporter tous les modules d'un seul coup
virer ceux qui ne m'interessent pas et hop on a tout !

Le but de cette procedure est de récupérer des classeurs bloqués: En ce qui concerne ta derniere remarque il y a possiblité de le faire directement sans passer par Open Office ...o)


bonne soirée
MichelXld
 

MichelXld

XLDnaute Barbatruc
Re : Récupération des macros dans un classeur corrompu

re-re-bonsoir

Voici une nouvelle version qui permet de placer chaque procédure importée dans le bon type de module:
(module standard , module de classe , modules objets Feuille & ThisWorkbook )

Code:
Option Explicit
Option Compare Text

Sub MacrosRecovery_Excel_OOo_V102()
    '
    'MichelXld le 28.08.2006
    'macro testée avec Excel2002 et OOo 2.0.1
    '
    Dim serviceManager As Object, Desktop As Object
    Dim Document As Object
    Dim Fichier As String, Cible As String, TypeMod() As String
    Dim Args()
    Dim Tableau()
    Dim I As Integer, x As Integer, J As Integer
    Dim Wb As Workbook
    Dim Ws As Worksheet
    Dim VBComp As Object
    Dim v As Integer, y As Integer
    
    
    'Boîte de dialogue pour sélectionner un classeur sur le disque
    Fichier = _
    Application.GetOpenFilename("Classeurs Excel (*.xls), *.xls")
    If Fichier = "Faux" Then Exit Sub
    'Transforme le chemin du classeur au format URL
    Fichier = ConvertToURL(Fichier)
    'Création d'une instance Open Office
    Set serviceManager = CreateObject("com.sun.star.serviceManager")
    Set Desktop = _
    serviceManager.createInstance("com.sun.star.frame.Desktop")
    'Ouverture du fichier
    Set Document = _
        Desktop.loadComponentFromURL(Fichier, "_blank", 0, Args)
    'Récupère la liste des noms de modules dans un tableau.
    Tableau() = _
        Document.BasicLibraries.getByName("Standard").ElementNames
    
    'Création d'un nouveau classeur pour stocker les macros importées.
    Set Wb = Workbooks.Add(1)
    
    
    '------------------------
    'Boucle sur les noms de module pour en extraire le contenu
    For I = 0 To UBound(Tableau())
                
    TypeMod() = Split(Document.BasicLibraries.getByName("Standard"). _
                        getByName(Tableau(I)), vbCrLf)
    TypeMod() = Split(TypeMod(0), Chr(10))
    
    Select Case Mid(TypeMod(0), 30)
    
    Case "VBAClassModule" 'Module de classe
        Set VBComp = Wb.VBProject.VBComponents.Add(2)
        'Renomme le module de classe
        VBComp.Name = Mid(TypeMod(1), 5)
    
    Case "VBADocumentModule" 'ThisWorkbook & les feuilles
        
        If Mid(TypeMod(1), 5) = "ThisWorkbook" Then
            Set VBComp = Wb.VBProject.VBComponents("ThisWorkbook")
            Else
            
            Set Ws = Nothing
            On Error Resume Next
            Set Ws = Wb.Worksheets(Mid(TypeMod(1), 5))
            On Error GoTo 0
                
                If Ws Is Nothing Then
                    'Creation nouvelle feuille
                    Set Ws = Wb.Worksheets.Add
                    'Renomme la feuille et le CodeName
                    Ws.Name = Mid(TypeMod(1), 5)
                    Wb.VBProject.VBComponents(Ws.CodeName).Name = _
                        Mid(TypeMod(1), 5)
                    
                    Set VBComp = _
                        Wb.VBProject.VBComponents(Mid(TypeMod(1), 5))
                Else
                    Set VBComp = _
                        Wb.VBProject.VBComponents(Mid(TypeMod(1), 5))
                End If
        End If
        
    Case "VBAModule" 'Module standard
        Set VBComp = Wb.VBProject.VBComponents.Add(1)
        'Renomme le module standard
        VBComp.Name = Mid(TypeMod(1), 5)
    
    Case "VBAFormModule" 'UserForm
        Set VBComp = Wb.VBProject.VBComponents.Add(3)
        'Renomme l'UserForm
        VBComp.Name = Mid(TypeMod(1), 5)
    End Select
        
    'Insertion des procédures dans les modules
    With Wb.VBProject.VBComponents(VBComp.Name).CodeModule
            
        'Fait le ménage: Suppression d'"Option Explicit"
        .DeleteLines 1, .CountOfLines
    
        'Import de la procédure et remise en forme dans le module
        .AddFromString _
        Document.BasicLibraries.getByName("Standard"). _
                        getByName(Tableau(I))
        
            For J = .CountOfLines To 1 Step -1
                Cible = .Lines(J, 1)
                
                If Left(Cible, 17) = "Rem Attribute VBA" Then
                .DeleteLines J, 1
                Else
                
                    If Left(Cible, 3) = "Rem" Then
                        Cible = Mid(Cible, 4)
                        .ReplaceLine J, Cible
                        Else
                        .DeleteLines J, 1
                    End If
                    
                End If
            Next J
    End With
       
        'Suppression des modules vides
        If VBComp.Type = 1 Then
            v = VBComp.CodeModule.CountOfDeclarationLines + 1
            y = VBComp.CodeModule.CountOfLines
            If y < v Then Wb.VBProject.VBComponents.Remove VBComp
        End If
    Next I
    DoEvents
    'Fermeture du document OOo
    Document.Close (False)
    
End Sub

Function ConvertToURL(Fichier As String)
    'fonction de conversion  au format URL
    Dim Cible As String
    
        Cible = Fichier
        Cible = Replace(Cible, "\", "/")
        ConvertToURL = "[URL="file:///"]file:///[/URL]" & Cible
End Function


bonne soirée
MichelXld
 

MichelXld

XLDnaute Barbatruc
Re : Récupération des macros dans un classeur corrompu

bonjour

voici la mise à jour pour la version d'Open Office OOO2.0.3


Code:
Option Explicit
Option Compare Text
Sub MacrosRecovery_Excel_OOo_V203()
    '
    'MichelXld, mise à jour le 24.09.2006
    'macro testée avec Excel2002 et OOo 2.0.3
    '
    '
    '------------  Important /!\ ------------------
    'pour une utilisation avec OOo 2.0.1, remplacez:
    '
    '   Mid(TypeMod(2), 5)
    '   par
    '   Mid(TypeMod(1), 5)
    '----------------------------------------------
    
    Dim serviceManager As Object, Desktop As Object
    Dim Document As Object
    Dim Fichier As Variant
    Dim Cible As String, TypeMod() As String
    Dim Args()
    Dim Tableau()
    Dim I As Integer, x As Integer, J As Integer
    Dim Wb As Workbook
    Dim Ws As Worksheet
    Dim VBComp As Object
    Dim v As Integer, y As Integer
    
    
    'Boîte de dialogue pour sélectionner un classeur sur le disque
    Fichier = _
    Application.GetOpenFilename("Classeurs Excel (*.xls), *.xls")
    If Fichier = False Then Exit Sub
    'Transforme le chemin du classeur au format URL
    Fichier = ConvertToURL(Fichier)
    'Création d'une instance Open Office
    Set serviceManager = CreateObject("com.sun.star.serviceManager")
    Set Desktop = _
    serviceManager.createInstance("com.sun.star.frame.Desktop")
   'Ouverture du fichier
    Set Document = _
        Desktop.loadComponentFromURL(Fichier, "_blank", 0, Args)
    'Récupère la liste des noms de modules dans un tableau.
    Tableau() = _
        Document.BasicLibraries.getByName("Standard").ElementNames
    
    'Création d'un nouveau classeur pour stocker les macros importées.
    Set Wb = Workbooks.Add(1)
    
    
    '------------------------
    'Boucle sur les noms de module pour en extraire le contenu
    For I = 0 To UBound(Tableau())
                
    TypeMod() = Split(Document.BasicLibraries.getByName("Standard"). _
                        getByName(Tableau(I)), vbCrLf)
    TypeMod() = Split(TypeMod(0), Chr(10))
    
    Select Case Mid(TypeMod(0), 30)
    
    Case "VBAClassModule" 'Module de classe
        Set VBComp = Wb.VBProject.VBComponents.Add(2)
        'Renomme le module de classe
        VBComp.Name = Mid(TypeMod(2), 5)
    
    Case "VBADocumentModule" 'ThisWorkbook & les feuilles
        
        If Mid(TypeMod(2), 5) = "ThisWorkbook" Then
            Set VBComp = Wb.VBProject.VBComponents("ThisWorkbook")
            Else
            
            Set Ws = Nothing
            On Error Resume Next
            Set Ws = Wb.Worksheets(Mid(TypeMod(2), 5))
            On Error GoTo 0
                
                If Ws Is Nothing Then
                    'Creation nouvelle feuille
                    Set Ws = Wb.Worksheets.Add
                    'Renomme la feuille et le CodeName
                    Ws.Name = Mid(TypeMod(2), 5)
                    Wb.VBProject.VBComponents(Ws.CodeName).Name = _
                        Mid(TypeMod(2), 5)
                    
                    Set VBComp = _
                        Wb.VBProject.VBComponents(Mid(TypeMod(2), 5))
                Else
                    Set VBComp = _
                        Wb.VBProject.VBComponents(Mid(TypeMod(2), 5))
                End If
        End If
        
    Case "VBAModule" 'Module standard
        Set VBComp = Wb.VBProject.VBComponents.Add(1)
        'Renomme le module standard
        VBComp.Name = Mid(TypeMod(2), 5)
    
    Case "VBAFormModule" 'UserForm
        Set VBComp = Wb.VBProject.VBComponents.Add(3)
        'Renomme l'UserForm
        VBComp.Name = Mid(TypeMod(2), 5)
    End Select
        
    'Insertion des procédures dans les modules
    With Wb.VBProject.VBComponents(VBComp.Name).CodeModule
            
        'Fait le ménage: Suppression d'"Option Explicit"
        .DeleteLines 1, .CountOfLines
    
        'Import de la procédure et remise en forme dans le module
        .AddFromString _
        Document.BasicLibraries.getByName("Standard"). _
                        getByName(Tableau(I))
        
            For J = .CountOfLines To 1 Step -1
                Cible = .Lines(J, 1)
                
                If Left(Cible, 17) = "Rem Attribute VBA" Then
                .DeleteLines J, 1
                Else
                
                    If Left(Cible, 3) = "Rem" Then
                        Cible = Mid(Cible, 4)
                        .ReplaceLine J, Cible
                        Else
                        .DeleteLines J, 1
                    End If
                    
                End If
            Next J
    End With
       
        'Suppression des modules vides
        If VBComp.Type = 1 Then
            v = VBComp.CodeModule.CountOfDeclarationLines + 1
            y = VBComp.CodeModule.CountOfLines
            If y < v Then Wb.VBProject.VBComponents.Remove VBComp
        End If
    Next I
    DoEvents
    'Fermeture du document OOo
    Document.Close (False)
    
End Sub

Function ConvertToURL(Fichier As Variant)
    'fonction de conversion  au format URL
    Dim Cible As String
    
        Cible = Fichier
        Cible = Replace(Cible, "\", "/")
        ConvertToURL = "[URL="file:///"]file:///[/URL]" & Cible
End Function


bonne fin de week end
MichelXld
 

Discussions similaires

Réponses
2
Affichages
99

Statistiques des forums

Discussions
311 725
Messages
2 081 947
Membres
101 849
dernier inscrit
florentMIG