web-dev-qa-db-fra.com

Excel VBA - Comment activer les numéros de ligne dans l'éditeur de code

Merci de bien vouloir aider: comment activer les numéros de ligne dans l'éditeur de code VBA Excel? J'utilise la version Excel 2013.

Je vous remercie.

excel-vbavbaexcel
8
Sohel

Voici mon code pour ajouter des numéros de ligne dans l'IDE VBE. C'est une amélioration de la solution fournie ici par Excel MVP mikerickson. J'ai travaillé là-dessus, car dans de rares cas que j'ai déjà rencontrés, VBE ne peut pas entrer en mode débogage, par exemple lorsque vous avez une méthode .ReplaceLine dans votre code. En effet, vous ne pouvez pas entrer en mode débogage une fois qu'il a été exécuté, donc Erl pourrait être utile pour le débogage (au lieu de Debug.Print). J'ai ajouté plusieurs fonctionnalités telles que: 

  • possibilité d'ajouter des numéros de ligne sous forme d'étiquettes: 10: Dim foo as bar ou sous forme de nombres simples séparés du code par un onglet: 10 Dim foo as bar
  • possibilité d'ajouter des numéros de ligne aux instructions de fin de procédure et de faire correspondre le retrait des lignes de déclaration de procédure à sa ligne de déclaration de fin une fois numérotées. Ou pas.
  • possibilité d'ajouter ou non des numéros de lignes à des lignes vides
  • [WIP] possibilité d'ajouter des numéros de ligne à une procédure spécifique dans un module
  • [WIP] correspond à toutes les indentations des lignes de code avec des numéros de ligne correspondant à l'indentation de la dernière ligne indentée. Si la dernière ligne est 200: End Sub, la ligne 30: With ActiveSheet sera indentée en tant que 30: ActiveSheet
  • [WIP] ajout d'une commande VBE IDE pour passer directement les appels avec le module actuel/proc en tant que paramètre
Public Enum vbLineNumbers_LabelTypes
    vbLabelColon    ' 0
    vbLabelTab      ' 1
End Enum

Public Enum vbLineNumbers_ScopeToAddLineNumbersTo
    vbScopeAllProc  ' 1
    vbScopeThisProc ' 2
End Enum

Sub AddLineNumbers(ByVal wbName As String, _
                   ByVal vbCompName As String, _
                   ByVal LabelType As vbLineNumbers_LabelTypes, _
                   ByVal AddLineNumbersToEmptyLines As Boolean, _
                   ByVal AddLineNumbersToEndOfProc As Boolean, _
                   ByVal Scope As vbLineNumbers_ScopeToAddLineNumbersTo, _
                   Optional ByVal thisProcName As String)

' USAGE RULES
' DO NOT MIX LABEL TYPES FOR LINE NUMBERS! IF ADDING LINE NUMBERS AS COLON TYPE, ANY LINE NUMBERS AS VBTAB TYPE MUST BE REMOVE BEFORE, AND RECIPROCALLY ADDING LINE NUMBERS AS VBTAB TYPE

    Dim i As Long
    Dim j As Long
    Dim procName As String
    Dim startOfProcedure As Long
    Dim lengthOfProcedure As Long
    Dim endOfProcedure As Long
    Dim strLine As String

    With Workbooks(wbName).VBProject.VBComponents(vbCompName).CodeModule
        .CodePane.Window.Visible = False

If Scope = vbScopeAllProc Then

        For i = 1 To .CountOfLines

            strLine = .Lines(i, 1)
            procName = .ProcOfLine(i, vbext_pk_Proc) ' Type d'argument ByRef incompatible ~~> Requires VBIDE library as a Reference for the VBA Project

            If procName <> vbNullString Then
                startOfProcedure = .ProcStartLine(procName, vbext_pk_Proc)
                bodyOfProcedure = .ProcBodyLine(procName, vbext_pk_Proc)
                countOfProcedure = .ProcCountLines(procName, vbext_pk_Proc)

                prelinesOfProcedure = bodyOfProcedure - startOfProcedure
                'postlineOfProcedure = ??? not directly available since endOfProcedure is itself not directly available.

                lengthOfProcedure = countOfProcedure - prelinesOfProcedure ' includes postlinesOfProcedure !
                'endOfProcedure = ??? not directly available, each line of the proc must be tested until the End statement is reached. See below.

                If endOfProcedure <> 0 And startOfProcedure < endOfProcedure And i > endOfProcedure Then
                    GoTo NextLine
                End If

                If i = bodyOfProcedure Then InProcBodyLines = True

                If bodyOfProcedure < i And i < startOfProcedure + countOfProcedure Then
                    If Not (.Lines(i - 1, 1) Like "* _") Then

                        InProcBodyLines = False

                        PreviousIndentAdded = 0

                        If Trim(strLine) = "" And Not AddLineNumbersToEmptyLines Then GoTo NextLine

                        If IsProcEndLine(wbName, vbCompName, i) Then
                            endOfProcedure = i
                            If AddLineNumbersToEndOfProc Then
                                Call IndentProcBodyLinesAsProcEndLine(wbName, vbCompName, LabelType, endOfProcedure)
                            Else
                                GoTo NextLine
                            End If
                        End If

                        If LabelType = vbLabelColon Then
                            If HasLabel(strLine, vbLabelColon) Then strLine = RemoveOneLineNumber(.Lines(i, 1), vbLabelColon)
                            If Not HasLabel(strLine, vbLabelColon) Then
                                temp_strLine = strLine
                                .ReplaceLine i, CStr(i) & ":" & strLine
                                new_strLine = .Lines(i, 1)
                                If Len(new_strLine) = Len(CStr(i) & ":" & temp_strLine) Then
                                    PreviousIndentAdded = Len(CStr(i) & ":")
                                Else
                                    PreviousIndentAdded = Len(CStr(i) & ": ")
                                End If
                            End If
                        ElseIf LabelType = vbLabelTab Then
                            If Not HasLabel(strLine, vbLabelTab) Then strLine = RemoveOneLineNumber(.Lines(i, 1), vbLabelTab)
                            If Not HasLabel(strLine, vbLabelColon) Then
                                temp_strLine = strLine
                                .ReplaceLine i, CStr(i) & vbTab & strLine
                                PreviousIndentAdded = Len(strLine) - Len(temp_strLine)
                            End If
                        End If

                    Else
                        If Not InProcBodyLines Then
                            If LabelType = vbLabelColon Then
                                .ReplaceLine i, Space(PreviousIndentAdded) & strLine
                            ElseIf LabelType = vbLabelTab Then
                                .ReplaceLine i, Space(4) & strLine
                            End If
                        Else
                        End If
                    End If

                End If

            End If

NextLine:
        Next i

ElseIf AddLineNumbersToEmptyLines And Scope = vbScopeThisProc Then

End If

        .CodePane.Window.Visible = True
    End With

End Sub

Function IsProcEndLine(ByVal wbName As String, _
                   ByVal vbCompName As String, _
                   ByVal Line As Long) As Boolean

With Workbooks(wbName).VBProject.VBComponents(vbCompName).CodeModule
    If Trim(.Lines(Line, 1)) Like "End Sub*" _
    Or Trim(.Lines(Line, 1)) Like "End Function*" _
    Or Trim(.Lines(Line, 1)) Like "End Property*" _
    Then IsProcEndLine = True
End With

End Function

Sub IndentProcBodyLinesAsProcEndLine(ByVal wbName As String, ByVal vbCompName As String, ByVal LabelType As vbLineNumbers_LabelTypes, ByVal ProcEndLine As Long)
    Dim procName As String
    Dim startOfProcedure As Long
    Dim endOfProcedure As Long

    With Workbooks(wbName).VBProject.VBComponents(vbCompName).CodeModule

        procName = .ProcOfLine(ProcEndLine, vbext_pk_Proc)
        bodyOfProcedure = .ProcBodyLine(procName, vbext_pk_Proc)
        endOfProcedure = ProcEndLine
        strEnd = .Lines(endOfProcedure, 1)

        j = bodyOfProcedure
        Do Until Not .Lines(j - 1, 1) Like "* _" And j <> bodyOfProcedure

            strLine = .Lines(j, 1)

            If LabelType = vbLabelColon Then
                If Mid(strEnd, Len(CStr(endOfProcedure)) + 1 + 1 + 1, 1) = " " Then
                    .ReplaceLine j, Space(Len(CStr(endOfProcedure)) + 1) & strLine
                Else
                    .ReplaceLine j, Space(Len(CStr(endOfProcedure)) + 2) & strLine
                End If
            ElseIf LabelType = vbLabelTab Then
                If endOfProcedure < 1000 Then
                    .ReplaceLine j, Space(4) & strLine
                Else
                    Debug.Print "This tool is limited to 999 lines of code to work properly."
                End If
            End If

            j = j + 1
        Loop

    End With
End Sub

Sub RemoveLineNumbers(ByVal wbName As String, ByVal vbCompName As String, ByVal LabelType As vbLineNumbers_LabelTypes)
    Dim i As Long
    With Workbooks(wbName).VBProject.VBComponents(vbCompName).CodeModule

        For i = 1 To .CountOfLines

            procName = .ProcOfLine(i, vbext_pk_Proc)

            If procName <> vbNullString Then

                If i = .ProcBodyLine(procName, vbext_pk_Proc) Then InProcBodyLines = True

                LenghtBefore = Len(.Lines(i, 1))
                If Not .Lines(i - 1, 1) Like "* _" Then
                    InProcBodyLines = False
                    .ReplaceLine i, RemoveOneLineNumber(.Lines(i, 1), LabelType)
                Else
                    If IsInProcBodyLines Then
                        ' do nothing
                    Else
                        .ReplaceLine i, Mid(.Lines(i, 1), RemovedChars_previous_i + 1)
                    End If
                End If
                LenghtAfter = Len(.Lines(i, 1))

                LengthBefore_previous_i = LenghtBefore
                LenghtAfter_previous_i = LenghtAfter
                RemovedChars_previous_i = LengthBefore_previous_i - LenghtAfter_previous_i

                If Trim(.Lines(i, 1)) Like "End Sub*" Or Trim(.Lines(i, 1)) Like "End Function" Or Trim(.Lines(i, 1)) Like "End Property" Then

                    LenOfRemovedLeadingCharacters = LenghtBefore - LenghtAfter

                    procName = .ProcOfLine(i, vbext_pk_Proc)
                    bodyOfProcedure = .ProcBodyLine(procName, vbext_pk_Proc)

                    j = bodyOfProcedure
                    strLineBodyOfProc = .Lines(bodyOfProcedure, 1)
                    Do Until Not strLineBodyOfProc Like "* _"
                        j = j + 1
                        strLineBodyOfProc = .Lines(j, 1)
                    Loop
                    LastLineBodyOfProc = j
                    strLastLineBodyOfProc = strLineBodyOfProc

                    strLineEndOfProc = .Lines(i, 1)
                    For k = bodyOfProcedure To j
                        .ReplaceLine k, Mid(.Lines(k, 1), 1 + LenOfRemovedLeadingCharacters)
                    Next k

                    i = i + (j - bodyOfProcedure)
                    GoTo NextLine

                End If
            Else
            ' GoTo NextLine
            End If
NextLine:
        Next i
    End With
End Sub

Function RemoveOneLineNumber(ByVal aString As String, ByVal LabelType As vbLineNumbers_LabelTypes)
    RemoveOneLineNumber = aString
    If LabelType = vbLabelColon Then
        If aString Like "#:*" Or aString Like "##:*" Or aString Like "###:*" Then
            RemoveOneLineNumber = Mid(aString, 1 + InStr(1, aString, ":", vbTextCompare))
            If Left(RemoveOneLineNumber, 2) Like " [! ]*" Then RemoveOneLineNumber = Mid(RemoveOneLineNumber, 2)
        End If
    ElseIf LabelType = vbLabelTab Then
        If aString Like "#   *" Or aString Like "##  *" Or aString Like "### *" Then RemoveOneLineNumber = Mid(aString, 5)
        If aString Like "#" Or aString Like "##" Or aString Like "###" Then RemoveOneLineNumber = ""
    End If
End Function

Function HasLabel(ByVal aString As String, ByVal LabelType As vbLineNumbers_LabelTypes) As Boolean
    If LabelType = vbLabelColon Then HasLabel = InStr(1, aString & ":", ":") < InStr(1, aString & " ", " ")
    If LabelType = vbLabelTab Then
        HasLabel = Mid(aString, 1, 4) Like "#   " Or Mid(aString, 1, 4) Like "##  " Or Mid(aString, 1, 4) Like "### "
    End If
End Function

Function RemoveLeadingSpaces(ByVal aString As String) As String
    Do Until Left(aString, 1) <> " "
        aString = Mid(aString, 2)
    Loop
    RemoveLeadingSpaces = aString
End Function

Function WhatIsLineIndent(ByVal aString As String) As String
    i = 1
    Do Until Mid(aString, i, 1) <> " "
        i = i + 1
    Loop
    WhatIsLineIndent = i
End Function

Function HowManyLeadingSpaces(ByVal aString As String) As String
    HowManyLeadingSpaces = WhatIsLineIndent(aString) - 1
End Function

Vous pouvez faire des appels comme ceci:

Sub AddLineNumbers_vbLabelColon()
    AddLineNumbers wbName:="EvaluateCall.xlsm", vbCompName:="ModLineNumbers_testDest", LabelType:=vbLabelColon, AddLineNumbersToEmptyLines:=True, AddLineNumbersToEndOfProc:=True, Scope:=vbScopeAllProc
End Sub

Sub AddLineNumbers_vbLabelTab()
    AddLineNumbers wbName:="EvaluateCall.xlsm", vbCompName:="ModLineNumbers_testDest", LabelType:=vbLabelTab, AddLineNumbersToEmptyLines:=True, AddLineNumbersToEndOfProc:=True, Scope:=vbScopeAllProc
End Sub

Sub RemoveLineNumbers_vbLabelColon()
    RemoveLineNumbers wbName:="EvaluateCall.xlsm", vbCompName:="ModLineNumbers_testDest", LabelType:=vbLabelColon
End Sub

Sub RemoveLineNumbers_vbLabelTab()
    RemoveLineNumbers wbName:="EvaluateCall.xlsm", vbCompName:="ModLineNumbers_testDest", LabelType:=vbLabelTab
End Sub

Et pour rappel, voici quelques règles de compilation concernant les numéros de ligne:

  • non autorisé avant une déclaration de déclaration Sub/Function
  • non autorisé en dehors d'un proc
  • non autorisé sur une ligne suivant un caractère de continuation de ligne "_" (trait de soulignement)
  • pas autorisé à avoir plus d'une étiquette/numéro de ligne par ligne de code ~~> Les étiquettes existantes autres que les numéros de ligne doivent être testées, sinon une erreur de compilation se produira en essayant de forcer un numéro de ligne.
  • pas autorisé à utiliser des caractères qui ont déjà un sens spécial VBA ~~> Les caractères autorisés sont [a-Z], [0-9], é, è, ô, ù, €, £, § et même ":" seul!
  • le compilateur rognera tout espace avant une étiquette ~~> Donc, s'il y a une étiquette, le premier caractère de la ligne est le premier caractère de l'étiquette, il ne peut pas s'agir d'un espace.
  • ajouter un numéro de ligne avec un signe deux-points aura un espace inséré entre le ":" et le premier caractère s'il n'y en a pas
  • lors de l'ajout d'un numéro de ligne avec une tabulation/un espace, il doit y avoir au moins un espace entre le dernier chiffre et le premier caractère suivant, le compilateur ne l'ajoutera pas comme il le fait pour une étiquette avec un séparateur de deux points
  • la méthode .ReplaceLine remplacera les règles de compilation sans afficher d'erreur de compilation comme en mode conception lors de la sélection d'une nouvelle ligne ou lors de la relance manuelle de la compilation
  • le compilateur est "plus rapide que l'environnement/le système VBA": par exemple, juste après qu'un numéro de ligne avec deux points et sans aucun espace ait été inséré avec .ReplaceLine, si la propriété .Lines est appelée pour obtenir la nouvelle chaîne, l'espace ( entre le caractère deux-points et le premier caractère de la chaîne) est déjà ajouté à cette chaîne!
  • il n'est pas possible d'entrer en mode débogage après qu'un appel .ReplaceLine a été appelé (à l'intérieur ou à l'extérieur du module qu'il édite), tant que le code n'est pas en cours d'exécution et que l'exécution n'a pas été réinitialisée.
6
hymced

Réponse courte pour Excel 2016, je ne l'ai pas encore essayé en 2013.

Faire une fois:

  1. Collez le gros code de finalModule2 dans cette réponse dans votre classeur.
  2. Collez le code pour finalModule3 dans cette réponse, dans votre classeur.
  3. Collez le code pour finalModule4 dans cette réponse, dans votre classeur.
  4. Ensuite, collez la ligne Global allow_for_line_addition As String afin d’ajouter automatiquement linumbers` au-dessus/dans la première ligne de chaque module
  5. Supprimez toutes les lignes vides à la fin de chaque module (afin d'éviter toute perte après le dernier end sub, end function ou End Property d'un module).
  6. Dans l'éditeur VBA, sans exécuter de code ni en mode "pause": cliquez sur Outils> Références> mark: `Microsoft Visual Basic pour Applications Extensibility 5.3"

Faites chaque fois que vous avez modifié votre code:

  1. * Exécutez le code pour finalModule3 pour supprimer les numéros de ligne de tous les modules de votre classeur.
  2. * Exécutez le code pour finalModule4 pour ajouter des numéros de ligne à tous les modules de votre classeur. 

(* parce que parfois vous obtenez une erreur si vous coupez ou déplacez des lignes (par exemple, mettez line 2440: au-dessus de line 2303:). En les supprimant et en les rajoutant, la numérotation des lignes est automatiquement correcte à nouveau)

Réponse longue (y compris les étapes et tentatives d'apprentissage) - pour moi, il n'était pas simple d'implémenter la réponse de hymced, j'ai donc documenté les étapes nécessaires pour ajouter des numéros de ligne à un module dans l'éditeur de code VBA (* et les supprimer encore). J'ai suivi les étapes suivantes pour le faire fonctionner.

  1. De ce lien j'ai appris qu'un vbcomponent peut être un module.
  2. J'ai copié le premier code donné, dans temporaireModule2, et le deuxième code donné par hymced dans temporaireModule3.

  3. Puis modifié la première ligne du 2ème code dans temporaireModule3 en:

    AddLineNumbers wbName:="Book1.xlsm", vbCompName:="Module1", LabelType:=vbLabelColon, AddLineNumbersToEmptyLines:=True, AddLineNumbersToEndOfProc:=True, Scope:=vbScopeAllProc

  4. J'ai une erreur à la ligne:

    procName = .ProcOfLine(i, vbext_pk_Proc) ` Type d`argument ByRef incompatible ~~> Requires VBIDE library as a Reference for the VBA Project

  5. J'ai donc lu que je devais activer la bibliothèque VBIDE. 

  6. J'ai donc arrêté le code, cliqué sur outils> références et je n'ai pas trouvé la bibliothèque VBIDE.

  7. Sur ce forum j'ai trouvé que VBIDE est activé en ajoutant une référence à La bibliothèque d'extensibilité VBA:

Cliquez sur Outils-Références dans le VBE, faites défiler la liste et cochez la case entrée pour Microsoft Visual Basic pour Applications Extensibility 5.3.

Ainsi, après avoir fait cela, la première erreur a disparu et aucune ligne n'a été mise en surbrillance, mais elle a donné l'erreur "Appel ou argument de procédure non valide". 

  1. Comme je ne suis toujours pas sûr du nom de vbCompName, j'ai pensé qu'il devrait peut-être connaître le sous-répertoire à la place du module. J'ai donc essayé de modifier le deuxième code dans temporaireModule3 en:

    AddLineNumbers wbName:="Book1.xlsm", vbCompName:="learn", LabelType:=vbLabelColon, AddLineNumbersToEmptyLines:=True, AddLineNumbersToEndOfProc:=True, Scope:=vbScopeAllProc

  2. Cela a souligné la ligne:

    With Workbooks(wbName).VBProject.VBComponents(vbCompName).CodeModule

en disant: subscript out of range. (J'ai donc aussi essayé: Module1.learn et Module1:learn, générant l'erreur subscript out of range-.

Comme il s'avère, 

AddLineNumbers wbName:="Book1.xlsm", vbCompName:="Module1", LabelType:=vbLabelColon, AddLineNumbersToEmptyLines:=True, AddLineNumbersToEndOfProc:=True, Scope:=vbScopeAllProc

est le bon moyen d'appeler le remplaçant si celui que vous souhaitez fournir avec des numéros de ligne se trouve dans un module nommé Module1. La première erreur décrit se produit, mais elle ajoute les numéros de ligne au code (sauf la première ligne contenant sub ... et la dernière ligne contenant end sub. Testé dans Module1 nommé sub learn() du classeur Excel 2016 nommé Book1.xlsm. Pour compléter learn consiste en: 

Sub learn()
    ThisWorkbook.Worksheets("Sheet1").Activate
    Range("A1").Activate
    Range("A1").Select
    Range("A1").Value = Range("A1").Value + 1
End Sub

Cependant, au retour, en supprimant les numéros de ligne, une erreur s’est produite car il demande .lines (0,1) de procName in Sub AddLineNumbers...

  1. Je l'ai donc modifié pour exclure les lignes (0,1) en mettant le code modifié ci-dessous dans finalModule2:

    Public Enum vbLineNumbers_LabelTypes
    vbLabelColon    ' 0
    vbLabelTab      ' 1
End Enum

Public Enum vbLineNumbers_ScopeToAddLineNumbersTo
    vbScopeAllProc  ' 1
    vbScopeThisProc ' 2
End Enum
          Sub AddLineNumbers(ByVal wbName As String, _
                                                      ByVal vbCompName As String, _
                                                      ByVal LabelType As vbLineNumbers_LabelTypes, _
                                                      ByVal AddLineNumbersToEmptyLines As Boolean, _
                                                      ByVal AddLineNumbersToEndOfProc As Boolean, _
                                                      ByVal Scope As vbLineNumbers_ScopeToAddLineNumbersTo, _
                                                      Optional ByVal thisProcName As String)

' USAGE RULES
' DO NOT MIX LABEL TYPES FOR LINE NUMBERS! IF ADDING LINE NUMBERS AS COLON TYPE, ANY LINE NUMBERS AS VBTAB TYPE MUST BE REMOVE BEFORE, AND RECIPROCALLY ADDING LINE NUMBERS AS VBTAB TYPE

    Dim i As Long
    Dim j As Long
    Dim procName As String
    Dim startOfProcedure As Long
    Dim lengthOfProcedure As Long
    Dim endOfProcedure As Long
    Dim strLine As String

    With Workbooks(wbName).VBProject.VBComponents(vbCompName).CodeModule
        .CodePane.Window.Visible = False

If Scope = vbScopeAllProc Then

        For i = 1 To .CountOfLines - 1

            strLine = .Lines(i, 1)
            procName = .ProcOfLine(i, vbext_pk_Proc) ' Type d'argument ByRef incompatible ~~> Requires VBIDE library as a Reference for the VBA Project

            If procName <> vbNullString Then
                startOfProcedure = .ProcStartLine(procName, vbext_pk_Proc)
                bodyOfProcedure = .ProcBodyLine(procName, vbext_pk_Proc)
                countOfProcedure = .ProcCountLines(procName, vbext_pk_Proc)

                prelinesOfProcedure = bodyOfProcedure - startOfProcedure
                'postlineOfProcedure = ??? not directly available since endOfProcedure is itself not directly available.

                lengthOfProcedure = countOfProcedure - prelinesOfProcedure ' includes postlinesOfProcedure !
                'endOfProcedure = ??? not directly available, each line of the proc must be tested until the End statement is reached. See below.

                If endOfProcedure <> 0 And startOfProcedure < endOfProcedure And i > endOfProcedure Then
                    GoTo NextLine
                End If

                If i = bodyOfProcedure Then inprocbodylines = True

                If bodyOfProcedure < i And i < startOfProcedure + countOfProcedure Then
                    If Not (.Lines(i - 1, 1) Like "* _") Then

                        inprocbodylines = False

                        PreviousIndentAdded = 0

                        If Trim(strLine) = "" And Not AddLineNumbersToEmptyLines Then GoTo NextLine

                        If IsProcEndLine(wbName, vbCompName, i) Then
                            endOfProcedure = i
                            If AddLineNumbersToEndOfProc Then
                                Call IndentProcBodyLinesAsProcEndLine(wbName, vbCompName, LabelType, endOfProcedure)
                            Else
                                GoTo NextLine
                            End If
                        End If

                        If LabelType = vbLabelColon Then
                            If HasLabel(strLine, vbLabelColon) Then strLine = RemoveOneLineNumber(.Lines(i, 1), vbLabelColon)
                            If Not HasLabel(strLine, vbLabelColon) Then
                                temp_strLine = strLine
                                .ReplaceLine i, CStr(i) & ":" & strLine
                                new_strLine = .Lines(i, 1)
                                If Len(new_strLine) = Len(CStr(i) & ":" & temp_strLine) Then
                                    PreviousIndentAdded = Len(CStr(i) & ":")
                                Else
                                    PreviousIndentAdded = Len(CStr(i) & ": ")
                                End If
                            End If
                        ElseIf LabelType = vbLabelTab Then
                            If Not HasLabel(strLine, vbLabelTab) Then strLine = RemoveOneLineNumber(.Lines(i, 1), vbLabelTab)
                            If Not HasLabel(strLine, vbLabelColon) Then
                                temp_strLine = strLine
                                .ReplaceLine i, CStr(i) & vbTab & strLine
                                PreviousIndentAdded = Len(strLine) - Len(temp_strLine)
                            End If
                        End If

                    Else
                        If Not inprocbodylines Then
                            If LabelType = vbLabelColon Then
                                .ReplaceLine i, Space(PreviousIndentAdded) & strLine
                            ElseIf LabelType = vbLabelTab Then
                                .ReplaceLine i, Space(4) & strLine
                            End If
                        Else
                        End If
                    End If

                End If

            End If

NextLine:
        Next i

ElseIf AddLineNumbersToEmptyLines And Scope = vbScopeThisProc Then

End If

        .CodePane.Window.Visible = True
    End With

End Sub
          Function IsProcEndLine(ByVal wbName As String, _
              ByVal vbCompName As String, _
              ByVal Line As Long) As Boolean

With Workbooks(wbName).VBProject.VBComponents(vbCompName).CodeModule
If Trim(.Lines(Line, 1)) Like "End Sub*" _
            Or Trim(.Lines(Line, 1)) Like "End Function*" _
            Or Trim(.Lines(Line, 1)) Like "End Property*" _
            Then IsProcEndLine = True
End With

End Function
          Sub IndentProcBodyLinesAsProcEndLine(ByVal wbName As String, ByVal vbCompName As String, ByVal LabelType As vbLineNumbers_LabelTypes, ByVal ProcEndLine As Long)
    Dim procName As String
    Dim startOfProcedure As Long
    Dim endOfProcedure As Long

    With Workbooks(wbName).VBProject.VBComponents(vbCompName).CodeModule

        procName = .ProcOfLine(ProcEndLine, vbext_pk_Proc)
        bodyOfProcedure = .ProcBodyLine(procName, vbext_pk_Proc)
        endOfProcedure = ProcEndLine
        strEnd = .Lines(endOfProcedure, 1)

        j = bodyOfProcedure
        Do Until Not .Lines(j - 1, 1) Like "* _" And j <> bodyOfProcedure

            strLine = .Lines(j, 1)

            If LabelType = vbLabelColon Then
                If Mid(strEnd, Len(CStr(endOfProcedure)) + 1 + 1 + 1, 1) = " " Then
                    .ReplaceLine j, Space(Len(CStr(endOfProcedure)) + 1) & strLine
                Else
                    .ReplaceLine j, Space(Len(CStr(endOfProcedure)) + 2) & strLine
                End If
            ElseIf LabelType = vbLabelTab Then
                If endOfProcedure < 1000 Then
                    .ReplaceLine j, Space(4) & strLine
                Else
                    Debug.Print "This tool is limited to 999 lines of code to work properly."
                End If
            End If

            j = j + 1
        Loop

    End With
End Sub
          Sub RemoveLineNumbers(ByVal wbName As String, ByVal vbCompName As String, ByVal LabelType As vbLineNumbers_LabelTypes)
    Dim i As Long
    With Workbooks(wbName).VBProject.VBComponents(vbCompName).CodeModule
        'MsgBox ("nr of lines = " & .CountOfLines & vbNewLine & "Procname = " & procName)
            'MsgBox ("nr of lines REMEMBER MUST BE LARGER THAN 7! = " & .CountOfLines)
        For i = 1 To .CountOfLines
            procName = .ProcOfLine(i, vbext_pk_Proc)
            If procName <> vbNullString Then
                If i > 1 Then
                        'MsgBox ("Line " & i & " is a body line " & .ProcBodyLine(procName, vbext_pk_Proc))
                    If i = .ProcBodyLine(procName, vbext_pk_Proc) Then inprocbodylines = True
                        If .Lines(i - 1, 1) <> "" Then
                            'MsgBox (.Lines(i - 1, 1))
                        End If
                    If Not .Lines(i - 1, 1) Like "* _" Then
                        'MsgBox (inprocbodylines)
                        inprocbodylines = False
                            'MsgBox ("recoginized a line that should be substituted: " & i)
                        'MsgBox ("about to replace " & .Lines(i, 1) & vbNewLine & " with: " & RemoveOneLineNumber(.Lines(i, 1), LabelType) & vbNewLine & " with label type: " & LabelType)
                        .ReplaceLine i, RemoveOneLineNumber(.Lines(i, 1), LabelType)
                    Else
                        If IsInProcBodyLines Then
                            ' do nothing
                                'MsgBox (i)
                        Else
                            .ReplaceLine i, Mid(.Lines(i, 1), RemovedChars_previous_i + 1)
                        End If
                    End If
                End If
            Else
            ' GoTo NextLine
            End If
NextLine:
        Next i
    End With
End Sub
          Function RemoveOneLineNumber(ByVal aString As String, ByVal LabelType As vbLineNumbers_LabelTypes)
    RemoveOneLineNumber = aString
    If LabelType = vbLabelColon Then
        If aString Like "#:*" Or aString Like "##:*" Or aString Like "###:*" Or aString Like "####:*" Then
            RemoveOneLineNumber = Mid(aString, 1 + InStr(1, aString, ":", vbTextCompare))
            If Left(RemoveOneLineNumber, 2) Like " [! ]*" Then RemoveOneLineNumber = Mid(RemoveOneLineNumber, 2)
        End If
    ElseIf LabelType = vbLabelTab Then
        If aString Like "#   *" Or aString Like "##  *" Or aString Like "### *" Or aString Like "#### *" Then RemoveOneLineNumber = Mid(aString, 5)
        If aString Like "#" Or aString Like "##" Or aString Like "###" Or aString Like "####" Then RemoveOneLineNumber = ""
    End If
End Function
          Function HasLabel(ByVal aString As String, ByVal LabelType As vbLineNumbers_LabelTypes) As Boolean
    If LabelType = vbLabelColon Then HasLabel = InStr(1, aString & ":", ":") < InStr(1, aString & " ", " ")
    If LabelType = vbLabelTab Then
        HasLabel = Mid(aString, 1, 4) Like "#   " Or Mid(aString, 1, 4) Like "##  " Or Mid(aString, 1, 4) Like "### " Or Mid(aString, 1, 5) Like "#### "
    End If
End Function
          Function RemoveLeadingSpaces(ByVal aString As String) As String
    Do Until Left(aString, 1) <> " "
        aString = Mid(aString, 2)
    Loop
    RemoveLeadingSpaces = aString
End Function
          Function WhatIsLineIndent(ByVal aString As String) As String
    i = 1
    Do Until Mid(aString, i, 1) <> " "
        i = i + 1
    Loop
    WhatIsLineIndent = i
End Function

          Function HowManyLeadingSpaces(ByVal aString As String) As String
    HowManyLeadingSpaces = WhatIsLineIndent(aString) - 1
End Function

En appelant le remplaçant sur sub learn() avec le code ci-dessous, collé dans temporairemodule3:

    Sub AddLineNumbers_vbLabelColon()
    AddLineNumbers wbName:="Book1.xlsm", vbCompName:="Module1", LabelType:=vbLabelColon, AddLineNumbersToEmptyLines:=True, AddLineNumbersToEndOfProc:=True, Scope:=vbscopeallproc
End Sub

Sub AddLineNumbers_vbLabelTab()
    AddLineNumbers wbName:="Book1.xlsm", vbCompName:="Module1", LabelType:=vbLabelTab, AddLineNumbersToEmptyLines:=True, AddLineNumbersToEndOfProc:=True, Scope:=vbscopeallproc
End Sub

Sub RemoveLineNumbers_vbLabelColon()
    RemoveLineNumbers wbName:="Book1.xlsm", vbCompName:="Module1", LabelType:=vbLabelColon
End Sub

Sub RemoveLineNumbers_vbLabelTab()
    RemoveLineNumbers wbName:="Book1.xlsm", vbCompName:="Module1", LabelType:=vbLabelTab
End Sub

Maintenant, cela a fonctionné (ajouter et supprimer des numéros de ligne, avec les 4 méthodes permettant d’appeler l’ajout/la suppression de numéros de ligne collés dans temporairemodule2 pour un seul sous-module dans un module (module1 dans le cas de l’exemple). mettre 2 sous-appareils l'un derrière l'autre dans le même module, auquel cas le code n'a pas changé les numéros de ligne ajoutés au 2e sous-marin.

  1. J'ai donc ajouté la ligne suivante ci-dessus Module1:

    Global allow_for_line_addition As String

Faire Module1 ressembler à:

Global allow_for_line_addition As String
  Sub learn()
    ThisWorkbook.Worksheets("Sheet1").Activate
    Range("A1").Activate
    Range("A1").Select
    Range("A1").Value = Range("A1").Value + 1
End Sub
Sub learn2()
    ThisWorkbook.Worksheets("Sheet1").Activate
    Range("A1").Activate
    Range("A1").Select
    Range("A1").Value = Range("A1").Value + 1
End Sub

Maintenant, il a ajouté les numéros de ligne à l'ensemble du module, mais il n'a pas supprimé les numéros de ligne de l'ensemble du module. J'ai donc modifié le code de suppression de hymceds answer as well and already put it in the long code of **final**Module2`.

Remarque: Si vous avez des lignes blanches vides après la fin d'une sous-fonction ou d'une fonction, il continuera d'ajouter des lignes blanches chaque fois que vous exécutez le script pour ajouter les numéros de ligne (qui, après la première exécution, met simplement à jour les numéros de ligne). Ces numéros de ligne vides génèrent une erreur lors de l'exécution du code, vous devez donc les supprimer une fois. S'il n'y a pas de lignes vides à la fin d'un sous-marin, ce code n'en ajoutera pas de nouvelles.

  1. Pour ajouter des numéros de ligne à tous vos modules de votre classeur, conservez le code long dans finalModule2 tel que je l’ai modifié et remplacez le code temporaireModule3 par finalModule3:

    Global allow_for_line_addition As String 'this is just so that you can automatically add linenumbers
        Sub remove_line_numbering_all_modules()
'source: https://stackoverflow.com/questions/36791473/vba-getting-the-modules-in-workbook
'This code numbers all the modules in your .xlsm
    Dim vbcomp As VBComponent
    Dim modules As Collection
Set modules = New Collection
    For Each vbcomp In ThisWorkbook.VBProject.VBComponents
        'if normal or class module
        If ((vbcomp.Type = vbext_ct_StdModule) Or (vbcomp.Type = vbext_ct_ClassModule)) Then
               'V0:
               RemoveLineNumbers wbName:=ThisWorkbook.name, vbCompName:=vbcomp.name, LabelType:=vbLabelColon
               'V1:
               'Call RemoveLineNumbers(ThisWorkbook.name, vbcomp.name)
        End If
    Next vbcomp
End Sub

    Et ajoutez le code suivant à finalModule4:

    Global allow_for_line_addition As String 'this is just so that you can automatically add linenumbers
'This sub adds line numbers to all the modules after you have added the following line to every module
'add tools references Microsoft visual basic for applications (5.3) as checked
'Source httpsstackoverflow.comquestions40731182Excel-vba-how-to-turn-on-line-numbers-in-code-editor50368332#50368332
        Sub add_line_numbering_all_modules()
'source: https://www.stackoverflow.com/questions/36791473/vba-getting-the-modules-in-workbook
'This code numbers all the modules in your .xlsm
    Dim vbcomp As VBComponent
    Dim modules As Collection
    Set modules = New Collection
    For Each vbcomp In ThisWorkbook.VBProject.VBComponents
        'if normal or class module
        If ((vbcomp.Type = vbext_ct_StdModule) Or (vbcomp.Type = vbext_ct_ClassModule)) Then
               'V0:
               Call AddLineNumbers(ThisWorkbook.name, vbcomp.name, vbLabelColon, True, True, vbScopeAllProc)
               'v1
               'Call AddLineNumbers(ThisWorkbook.name, vbcomp.name)
        End If
    Next vbcomp
End Sub

où vous pouvez soit remplacer "Book1.xlsm" par le nom de votre propre classeur, soit par thisworkbook (notez non ""), ou inversement.

0
a.t.