Tym razem przedstawiam uproszczoną – moim zdaniem – wersję automatycznego dodawania numeracji wierszy do modułu VBA.

W poprzednim poście pt. „Dodawanie numerów linii do kodu VBA” zostawiłem dużo oryginalnego kodu. W poniższym kodzie wiele elementów oryginalnego kodu zostało pominięte, nie trzeba nawet dodawać referencji Microsoft Visual Basic for Applications Extensibility 5.3.

Moim zdaniem oznaczenia wierszy modułu bardzo się przydają gdy wprowadzimy obsługę błędów w naszym kodzie (On Error GoTo…). W przypadku błędu wprowadzamy zmienną ERL przez co wiemy w której linii jest błąd. Oczywiście można działać bez obsługi błędów, ale wtedy kod będzie zatrzymywany by przejść w tryb debugowania. Nie jest to złe rozwiązanie – na przykład gdy piszemy kod od razu wchodzimy do błędu – ale końcowemu użytkownikowi tryb debugowania nie powinien się pojawiać.

Aby uruchomić kod musimy podać nazwę modułu do którego chcemy dodać linie kodu i wejść w makro przez F5, czy też F8.

Dodawanie oznaczeń wiersza:

' Żródło:
' https://www.mrexcel.com/forum/excel-questions/576449-code-line-numbers-vba.html
' https://windowssecrets.com/forums/showthread.php/172507-line-numbers-in-VBA-code


Private Sub AddLineNumbers()
' DODAWANIE OZNACZENIA WIERSZA W MODULE VBA

Dim i As Long, j As Long
Dim ModuleName As String
Dim ReplaceJump, LineValue, PrevLineValue, YesNo

ModuleName = "TwojaNazwaModulu" 'Podaj nazwę modułu

YesNo = MsgBox("Czy chcesz DODAC linie kodu do modulu:   '" & ModuleName & "'?", vbQuestion + vbYesNo, "AddLineNumbers...")
If YesNo = 6 Then
    With ThisWorkbook.VBProject.VBComponents(ModuleName).CodeModule
    
        j = 1
        For i = j To .CountOfLines
            LineValue = .Lines(i, 1)
            If Left(Trim(LineValue), 6) = "Public" Or Left(Trim(LineValue), 7) = "Private" Or _
                    Left(Trim(LineValue), 3) = "Sub" Or Left(Trim(LineValue), 8) = "Function" Then
            
                    For j = i + 1 To .CountOfLines
                        LineValue = .Lines(j, 1)
                        If Left(Trim(LineValue), 7) = "End Sub" Or Left(Trim(LineValue), 12) = "End Function" Or _
                            Left(Trim(LineValue), 6) = "Public" Or Left(Trim(LineValue), 7) = "Private" Or _
                            Left(Trim(LineValue), 7) = "Declare" Or Left(Trim(LineValue), 1) = "#" Then
                            Exit For
                        End If
                        
                        ' ----------------------------
                        ' WYŁACZENIA
                        
                        PrevLineValue = .Lines(j - 1, 1)
                        
                        If Len(Trim(LineValue)) = 0 Then
                            GoTo ReplaceJump
                        End If
                        
                        If Right(PrevLineValue, 1) = "_" Then
                            If j < 100 Then
                                .ReplaceLine j, "    " & vbTab & vbTab & LineValue
                            Else
                                .ReplaceLine j, "    " & vbTab & LineValue
                            End If
                            GoTo ReplaceJump
                        End If
                        
                        If Right(LineValue, 1) = ":" Then
                            GoTo ReplaceJump
                        End If
                        
                        If Left(Trim(LineValue), 4) = "Case" Then
                            If j < 100 Then
                                .ReplaceLine j, "    " & vbTab & vbTab & LineValue
                            Else
                                .ReplaceLine j, "    " & vbTab & LineValue
                            End If
                            GoTo ReplaceJump
                        End If
                        
                        If Left(Trim(LineValue), 3) = "Debug" Then
                            GoTo ReplaceJump
                        End If
                       
                        If Left(Trim(LineValue), 1) = "'" Then
                            .ReplaceLine j, vbTab & vbTab & LineValue     'ori
                            GoTo ReplaceJump
                        End If
                        
                        ' ----------------------------
                        ' DODANIE NUMERU WIERSZA

                        If j < 100 Then
                            .ReplaceLine j, CStr(j) & ":" & vbTab & vbTab & LineValue
                        Else
                            .ReplaceLine j, CStr(j) & ":" & vbTab & LineValue
                        End If
ReplaceJump:
                    Next j
            End If
        Next i
    End With
    MsgBox "DODANO line kodu." & Chr(10) & "Ilosc wierszy: " & j & ".", vbInformation, "POTWIERDZENIE..."
Else
    MsgBox "Anulowano."
End If 'If YesNo

End Sub

Usuwanie oznaczeń wierszy:

Uwaga: Kod będzie prawidłowo działał tylko i wyłącznie, gdy skorzystaliśmy z procedury dodania wierszy z tego posta.

' Żródło:
' https://www.mrexcel.com/forum/excel-questions/576449-code-line-numbers-vba.html
' https://windowssecrets.com/forums/showthread.php/172507-line-numbers-in-VBA-code

Sub RemoveLineNumber()
' USUWANIE OZNACZENIA WIERSZA W MODULE VBA

Dim i As Long, j As Long
Dim ModuleName As String
Dim LineValue, PrevLineValue, YesNo

ModuleName = "TwojaNazwaModulu" 'Podaj nazwę modułu

YesNo = MsgBox("Czy chcesz USUNAC linie kodu do modulu:   '" & ModuleName & "'?", vbQuestion + vbYesNo, "RemoveLineNumber...")
If YesNo = 6 Then
    With ThisWorkbook.VBProject.VBComponents(ModuleName).CodeModule
    
        j = 1
        For i = j To .CountOfLines
            LineValue = .Lines(i, 1)
            If Left(Trim(LineValue), 6) = "Public" Or Left(Trim(LineValue), 7) = "Private" Or _
                Left(Trim(LineValue), 3) = "Sub" Or Left(Trim(LineValue), 8) = "Function" Then
            
                For j = i + 1 To .CountOfLines
                    LineValue = .Lines(j, 1)
                        If Left(Trim(LineValue), 7) = "End Sub" Or Left(Trim(LineValue), 12) = "End Function" Or _
                            Left(Trim(LineValue), 6) = "Public" Or Left(Trim(LineValue), 7) = "Private" Or _
                            Left(Trim(LineValue), 7) = "Declare" Or Left(Trim(LineValue), 1) = "#" Then
                            Exit For
                        End If
                    
                    ' ----------------------------
                    ' EWENTUALNE USUWANIE NUMEREACJI LINII KODU
                    
                    If Left(Trim(LineValue), 1) Like "#*" Or Left(Trim(LineValue), 2) Like "##*" Or _
                         Left(Trim(LineValue), 3) Like "###*" Or Left(Trim(LineValue), 4) Like "####*" Then
                             .ReplaceLine j, Right(LineValue, Len(LineValue) - 8)
                    Else
                         PrevLineValue = .Lines(j - 1, 1)
                        
                         If Right(PrevLineValue, 1) = "_" Then
                             If Left(LineValue, 8) = "        " Then
                                 .ReplaceLine j, Right(LineValue, Len(LineValue) - 8)
                             Else
                                 ' nic sie nie dzieje
                             End If
                         End If
                         
                         If Left(Trim(LineValue), 4) = "Case" Then
                             If Left(LineValue, 8) = "        " Then
                                 .ReplaceLine j, Right(LineValue, Len(LineValue) - 8)
                             Else
                                 ' nic sie nie dzieje
                             End If
                         End If
                         
                         If Left(Trim(LineValue), 1) = "'" Then
                             If Left(LineValue, 8) = "        " Then
                                 .ReplaceLine j, Right(LineValue, Len(LineValue) - 8)
                             Else
                                 ' nic sie nie dzieje
                             End If
                         End If
                    End If
                Next j
            End If
        Next i
    End With
    MsgBox "USUNIETO linie kodu.", vbInformation, "POTWIERDZENIE..."
Else
    MsgBox "Anulowano."
End If 'If YesNo

End Sub