[Test-Excel] récupération des macros dans un classeur corrompu

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 est 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:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
Option Explicit
Option Compare Text
 
 
Sub MacrosRecovery_Excel_OOo()
    '
    'SilkyRoad 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 = "file:///" & 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.

toutes vos remarques sont les bienvenues.
d'avance merci.

en espérant que vous n'ayez jamais besoin de vous en servir réellement..;o)
bonne soiree
michel