Modifier fichier silkyroad

**Superpat9999** · 05/09/2019, 10h34

Bonjour,
Je me sers du fichier de silkyroad https://silkyroad.developpez.com/VBA...cEditor/#LII-D.
Celui-ci fonctionne bien, mais je souhaite que pour chaque nouvelle macro, on reparte de 10, comme numéro de ligne.
Dans la macro "NumerotationLignesProcedure'" actuellement il n'y a pas de remise à zéro.

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
 
Option Explicit
Option Compare Text
 
Sub testAjout()
'"laProcedure" est la macro dont vous souhaitez numéroter les lignes
NumerotationLignesProcedure "Module1", "laProcedure"
NumerotationLignesProcedure "Module1", "laProcedure_1"
NumerotationLignesProcedure "Module1", "laProcedure_2"
End Sub
 
 
Sub NumerotationLignesProcedure(nomModule As String, nomMacro As String)
'
'Cet exemple ne gère pas les erreurs s'il existe déja une numérotation
'
Dim Debut As Integer, Lignes As Integer, x As Integer
Dim Texte As String, strVar As String
 
With ThisWorkbook.VBProject.VBComponents(nomModule).CodeModule
    Debut = .ProcStartLine(nomMacro, 0)
    Lignes = .ProcCountLines(nomMacro, 0)
End With
 
For x = Debut + 2 To Debut + Lignes - 1
    With ThisWorkbook.VBProject.VBComponents(nomModule).CodeModule
        Texte = .Lines(x, 1)
        strVar = Application.WorksheetFunction.Substitute(Texte, " ", "")
        strVar = Application.WorksheetFunction.Substitute(strVar, vbCrLf, "")
        strVar = Application.WorksheetFunction.Substitute(strVar, vbTab, "")
 
        'Adaptez les filtres en fonction de vos projets.
        'Remarque: les arguments PrivateFunction et PublicFunction sont volontairement accolés.
        '
        If strVar <> "" And _
        Left(strVar, 3) <> "Sub" And _
        Left(strVar, 10) <> "PrivateSub" And _
        Left(strVar, 9) <> "PublicSub" And _
        Left(strVar, 8) <> "Function" And _
        Left(strVar, 15) <> "PrivateFunction" And _
        Left(strVar, 14) <> "PublicFunction" And _
        Right(ThisWorkbook.VBProject.VBComponents(nomModule). _
                CodeModule.Lines(x - 1, 1), 1) <> "_" _
        Then .ReplaceLine x, x & " " & Texte
    End With
Next
End Sub

Merci de votre aide

**Menhir** · 05/09/2019, 10h50

Par simple curiosité, une petite question : quel est l'intérêt de numéroter de lignes de VBA ?

J'ai commencé le Basic avec des éditeurs "à la ligne" qui obligeaient une numérotation de ligne.
On est parvenu à s'en libérer (et ce fut un grand soulagement) à la fin des années 80 avec Turbo Basic (bénit soit saint Bob).
Je ne comprends pas quel intérêt il pourrait y avoir à revenir en arrière, si ce n'est pour des besoins d'enseignement.

Pour ce qui est de ta question, ceci devrait faire l'affaire (même si ce n'est pas très propre) :

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
Sub NumerotationLignesProcedure(nomModule As String, nomMacro As String)
'
'Cet exemple ne gère pas les erreurs s'il existe déja une numérotation
'
Dim Debut As Integer, Lignes As Integer, x As Integer
Dim Texte As String, strVar As String
Dim CC As Long
 
CC = 0
 
With ThisWorkbook.VBProject.VBComponents(nomModule).CodeModule
    Debut = .ProcStartLine(nomMacro, 0)
    Lignes = .ProcCountLines(nomMacro, 0)
End With
 
For x = Debut + 2 To Debut + Lignes - 1
    With ThisWorkbook.VBProject.VBComponents(nomModule).CodeModule
        Texte = .Lines(x, 1)
        strVar = Application.WorksheetFunction.Substitute(Texte, " ", "")
        strVar = Application.WorksheetFunction.Substitute(strVar, vbCrLf, "")
        strVar = Application.WorksheetFunction.Substitute(strVar, vbTab, "")
 
        'Adaptez les filtres en fonction de vos projets.
        'Remarque: les arguments PrivateFunction et PublicFunction sont volontairement accolés.
        '
        If strVar <> "" And _
        Left(strVar, 3) <> "Sub" And _
        Left(strVar, 10) <> "PrivateSub" And _
        Left(strVar, 9) <> "PublicSub" And _
        Left(strVar, 8) <> "Function" And _
        Left(strVar, 15) <> "PrivateFunction" And _
        Left(strVar, 14) <> "PublicFunction" And _
        Right(ThisWorkbook.VBProject.VBComponents(nomModule). _
                CodeModule.Lines(x - 1, 1), 1) <> "_" _
        Then .ReplaceLine x, (x + 9 - CC) & " " & Texte Else CC = x
    End With
Next
End Sub

C'est du code tapé directement sur le forum et non testé, tu auras donc peut-être du débugage à faire.

**Thumb down** · 05/09/2019, 11h10

bonjour,
quand un code est bien ficelé, il n'y a aucun intérêt, dans le cas contraire il est possible de loguer les messages d'erreur en précisant le N° de ligne!

**Superpat9999** · 05/09/2019, 15h33

Merci Menhir pour ta réponse.
Effectivement il y a remise à 10, mais c'est la pagaille.
Après une ligne blanche qui n'est pas numérotée, on repart à 10.
Après un Sub on ne repart pas forcément à 10 (on peut repartir à la ligne numérotée 249...

**Igloobel** · 05/09/2019, 18h07

Bonjour,

au vu du sujet j'ai peur que l'on veuille faire des Goto N° ligne ...

chose que j'exècre au plus haut point

j'espère me tromper mais j'avoue que c'est louche

**Superpat9999** · 05/09/2019, 23h27

Je crois que j'ai trouvé...

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
Sub Test()
'Nécessite d'activer la référence
'"Visual basic For Application Extensibility 5.3"
'
Debug.Print recupereContenuMacro(Workbooks("Money.xlam"), "Module1", "Test")
Debug.Print recupereContenuMacro(Workbooks("Money.xlam"), "Module1", "uneProcedure")
 
Function recupereContenuMacro(Wb As Workbook, Mdl As String, NomMacro As String)
    Dim Debut As Integer, Fin As Integer, i As Integer
    Dim Ligne As Integer, x As Integer
    Dim strVar As String, strVar2 As String
    Dim Espace As String
    Ligne = 10
    Espace = "    "
    With Wb.VBProject.VBComponents(Mdl).CodeModule
        Debut = .ProcStartLine(NomMacro, vbext_pk_Proc)
        Fin = .ProcCountLines(NomMacro, vbext_pk_Proc) + Debut
            For i = Debut To Fin
                'Resultat = Resultat & .Lines(i, 1) & vbCr
                strVar = .Lines(i, 1)
                strVar2 = Replace(Trim(.Lines(i, 1)), " ", "")
 
                If Left(strVar2, 3) = "Sub" Or _
                    Left(strVar2, 6) = "EndSub" Or _
                    Left(strVar2, 7) = "ExitSub" Or _
                    Left(strVar2, 10) = "PrivateSub" Or _
                    Left(strVar2, 9) = "PublicSub" Or _
                    Left(strVar2, 8) = "Function" Or _
                    Left(strVar2, 11) = "EndFunction" Or _
                    Left(strVar2, 15) = "PrivateFunction" Or _
                    Left(strVar2, 14) = "PublicFunction" Or _
                    Left(strVar2, 3) = "Rem" Or _
                    Left(strVar2, 1) = "'" Or _
                    Len(Left(strVar2, 1)) = 0 Or _
                    Left(strVar2, 3) = "Dim" Or _
                    Left(strVar2, 10) = "ErrHandle:" Or _
                    Left(strVar2, 8) = "Handler:" Then
                    strVar = Espace & strVar
                 Else
                    'Debug.Print Left(strVar2, 1)
                    strVar = Ligne & Espace & strVar
                    Ligne = Ligne + 1
                End If
                  Debug.Print strVar
            Next
    End With
 
End Function

C'est ma proposition, ne demande qu'à s'améliorer.

**Superpat9999** · 15/09/2019, 23h44

Bonsoir,
Je joins un fichier pour numéroter et dénuméroter avec contrôle si la numérotation est existante ou non.
Je l'ai composé mais je ne suis pas responsable des erreurs qu'il pourrait impliquer. Chez moi tout fonctionne correctement et bien sûr, il ne demande qu'à être amélioré (je ne suis pas développeur professionnel).

.
Bonne soirée à tous.

Numerotation_Lignes.txt

**Menhir** · 16/09/2019, 10h16

Envoyé par Igloobel

au vu du sujet j'ai peur que l'on veuille faire des Goto N° ligne ...

J'espère que ce n'est pas le cas.
Parce que le code modifie les numéros de lignes sans modifier les références des éventuels Goto.
Donc, s'il existe déjà dans le code des "Goto n°ligne", ça va mettre une pagaille monstrueuse.

**Superpat9999** · 16/09/2019, 11h01

Je n'ai pas de goto dans mes codes, donc je n'ai pas traité ce cas.

Modifier fichier silkyroad [XL-2016]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager