Discussion :

[cotmar]

Bonjour,

Je reprends un programme VBA sous Excel qui représente plus de 92000 lignes de code. Vous avez bien lu... Et en plus dans ce code il y a eu pas mal de personnes différentes qui ont chacune eu leur manière de programmer, pour faire bonne mesure.

L'application plante régulièrement et comme il n'y a ps de gestion d'erreur, lorsque ça plante, il part en mode débug directement dans le code. Vous imaginez l'effet que celà produit lorsque celà se produit en pleine démonstration devant un client !

J'aurais voulu savoir si il était possibe d'insérer de manière automatique quelques lignes de code dans les procédures et les fonctions que je dois parcourir.

En clair est-il possible d'insérer :

- au début de chaque "sub/function" la ligne "on error goto ErrHandler"
- à la fin Les paragraphes "ErrHandler" (affichage du message d'erreur) et "ExitHandler" (contenant au moins un TODO en commentaire pour la libération de la mémoire dont je me chargerais ensuite).

Par avance je vous remercie.

Bon weekend.

Marco.

[helas]

Bonjour,
cela fonctionne mais il faut tester, il y a peut-être des particularités qui m'échappe

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub AjoutError()
 Dim m As Module, ligne() As String, s As String
 Dim i As Long, j As Long, n As Long
 
 s = InputBox("Nom du module", "Nom du module")
 If s = "" Then Exit Sub
 DoCmd.OpenModule s
 Set m = Modules(s)
 ligne = Split(m.Lines(1, m.CountOfLines), vbCrLf)
 
 j = UBound(ligne)
 Do Until j < 1  'on part de la fin du module
 
    If (Left$(ligne(j), 7) = "End Sub") Then  'est-ce une fin de procedure?
     m.InsertLines j + 1, "Exit Sub" & vbCrLf & "ErrHandler:" & vbCrLf & "MsgBox(""Erreur:"" & Error )"
    End If
    If (Left$(ligne(j), 12) = "End Function") Then  'est-ce une fin de fonction?
 
     m.InsertLines j + 1, "Exit Function" & vbCrLf & "ErrHandler:" & vbCrLf & "MsgBox(""Erreur:"" & Error )"
    End If
 
    If (Left$(ligne(j), 4) = "Sub ") Then  'est-ce un début de procedure
     m.InsertLines j + 2, "on error goto ErrHandler"
    End If
    If (Left$(ligne(j), 9) = "Function ") Then 'st-ce un début de fonction
     If Right$(ligne(j), 1) <> "_" Then  
      m.InsertLines j + 2, "on error goto ErrHandler"
     Else   'les paramètres de la fonction sont sur plusieurs lignes
      n = j
      Do Until Right$(ligne(n), 1) <> "_"
       n = n + 1
      Loop
      m.InsertLines n + 2, "on error goto ErrHandler"
     End If
    End If
 
    j = j - 1
 Loop
 DoCmd.Close acModule, s
End Sub

[cotmar]

Bonjour,

Je te remercies. Apparemment c'est du code VBA pour Access. je vais regarder ça et il va me faloir adapter très certainement.

En tous les cas merci. Je testes et je te tiens au courant.

Bonne journée.

Marco.

[cotmar]

Bonjour,

Désolé d'avoir mis autant de temps à répondre finalement.
Ca marche pas mal, même si j'ai un peut remanié le code pour des raisons diverses et variées.

J'ai un petit problème pour importer du code à partir d'un fichier externe dans une feuille.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub SubImportFeuilleCode2( _
        ByRef Wb As Workbook, _
        ByVal ModuleName As String, _
        ByVal ImportFromFile As String)
 
'Nécessite d'activer la référence "Microsoft Visual Basic for Applications Extensibility 5.3"
'    Dim Wb          As Workbook
    Dim oModule     As CodeModule
    Dim VbComp      As VBComponent
    Dim x           As Integer
    Dim Cible       As String
 
    Dim ArrLignes() As String
 
'On Error GoTo Erreur
On Error Resume Next
 
    Cible = ModuleName
    'Définit le classeur de destination (qui doit être préalablement ouvert).
'    Set Wb = Workbooks("NomClasseur.xls")
 
    'Charge le module dans le classeur
    Set VbComp = Wb.VBProject.VBComponents.Import(ImportFromFile) '"C:\ThisWorkbook.cls")
    'Le renomme (pour le supprimer plus facilement ultérieurement
    VbComp.Name = Cible
 
    Set oModule = VbComp.CodeModule
 
    If oModule.CountOfLines = 0 Then GoTo Sortie
 
    ArrLignes = Split(oModule.Lines(1, oModule.CountOfLines), vbCrLf)
 
  'Première solution
  '*****************
    For x = LBound(ArrLignes) To UBound(ArrLignes)
        With Wb.VBProject.VBComponents(ModuleName).CodeModule
            .AddFromString ArrLignes(x)
            .InsertLines x + 1, ArrLignes(x)  'oModule.Lines(x,  ArrLignes(x))  '"Exit Sub" & vbCrLf & "ErrHandler:" & vbCrLf & "MsgBox(""Erreur:"" & Error )"
        End With
    Next x
 
    'Deuxième solution
    '*****************
    With Wb.VBProject.VBComponents(ModuleName).CodeModule
        x = .CountOfLines
        .InsertLines 1, oModule.Lines(1, oModule.CountOfLines)
        .DeleteLines 1, x
    End With
 
    'Suppression du module précédemment chargé
    With Wb.VBProject.VBComponents
        .Remove .Item(Cible)
    End With
 
On Error GoTo 0
 
Sortie:
    Set oModule = Nothing
    Set VbComp = Nothing
    Exit Sub
 
Erreur:
    MsgBox Err.Number & " " & Err.Description, vbExclamation, "Export Import"
    GoTo Sortie
 
End Sub

Par avance je vous remercies.

Marco.