Dodawanie numerów linii do kodu VBA

Moim zdaniem włączenie obsługi błędów ma sens, gdy do kodu dodamy linie kodu. Niestety konsola VBA nie przewiduje takiego rozwiązania. Poniższy kod pozwala na dodanie numerów wierszy automatycznie.

Oryginalny kod został podany przez mikericksonTrochę go zmodyfikowałem. Kod jak w oryginale dodaje linie wierszy w całym module, natomiast dodałem parę wyłączeń zgodnie z drugim źródłem.

Zachęcam do skorzystania z aktualizacji kodu z tego postu: „Automatyczne dodawanie numeracji wierszy do modułu VBA”.

Ź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

Dodawanie numerów linii automatycznie:

' Trzeba dodać referenccję
' Microsoft Visual Basic for Applications Extensibility 5.3.

' Ź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

' Uwaga: Trzeba dodać referencję
' Microsoft Visual Basic for Applications Extensibility 5.3.

Private Sub AddLineNumbers()
Dim i As Long, j As Long, lineN As Long
Dim procName As String
Dim startOfProceedure As Long
Dim lengthOfProceedure As Long
Dim ModuleName As String
Dim ReplaceJump, LineValue, PrevLineValue, LenLine, YesNo

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

YesNo = MsgBox("Czy chcesz DODAC linie kodu do modulu:   '" & ModuleName & "'?", vbQuestion + vbYesNo, "PYTANIE...")
If YesNo = 6 Then
    With ThisWorkbook.VBProject.VBComponents(ModuleName).CodeModule
        For i = 1 To .CountOfLines
            procName = .ProcOfLine(i, vbext_pk_Proc)
            If procName <> vbNullString Then
                startOfProceedure = .ProcStartLine(procName, vbext_pk_Proc)
                If i = startOfProceedure Then
                    lengthOfProceedure = .ProcCountLines(procName, vbext_pk_Proc)
                    For j = 2 To lengthOfProceedure - 2
                        lineN = startOfProceedure + j
                        
                        ' ----------------------------
                        ' WYŁACZENIA
                        
                        LineValue = .Lines(lineN, 1)
                        PrevLineValue = .Lines(lineN - 1, 1)
                        
                        If Len(Trim(.Lines(lineN, 1))) = 0 Then
                            GoTo ReplaceJump
                        End If
                        
                        If Right(PrevLineValue, 1) = "_" Then
                            .ReplaceLine lineN, "    " & vbTab & vbTab & .Lines(lineN, 1)  'ori
                            GoTo ReplaceJump
                        End If
                        
                        If Right(LineValue, 1) = ":" Then
                            GoTo ReplaceJump
                        End If
                        
                        If Left(Trim(LineValue), 4) = "Case" Then
                            .ReplaceLine lineN, "    " & vbTab & vbTab & .Lines(lineN, 1)  'ori
                            GoTo ReplaceJump
                        End If
                        
                        If Left(Trim(LineValue), 6) = "Public" Then
                            GoTo ReplaceJump
                        End If
                        
                        If Left(Trim(LineValue), 7) = "Private" Then
                            GoTo ReplaceJump
                        End If
                        
                        If Left(Trim(LineValue), 3) = "Sub" Then
                            GoTo ReplaceJump
                        End If
                        
                        If Left(Trim(LineValue), 8) = "Function" Then
                            GoTo ReplaceJump
                        End If
                        
                        If Left(Trim(LineValue), 12) = "End Function" Then
                            GoTo ReplaceJump
                        End If
    
                        If Left(Trim(LineValue), 3) = "Debug" Then
                            GoTo ReplaceJump
                        End If
                        
                        If Left(Trim(LineValue), 7) = "End Sub" Then
                            GoTo ReplaceJump
                        End If
                        
                        If Left(Trim(LineValue), 1) = "'" Then
                            .ReplaceLine lineN, vbTab & vbTab & .Lines(lineN, 1)     'ori
                            GoTo ReplaceJump
                        End If
                        
                        ' ----------------------------
                        ' DODANIE NUMERU WIERSZA

                        If lineN < 100 Then
                            .ReplaceLine lineN, CStr(lineN) & ":" & vbTab & vbTab & .Lines(lineN, 1)
                        Else
                            .ReplaceLine lineN, CStr(lineN) & ":" & vbTab & .Lines(lineN, 1)
                        End If
ReplaceJump:
                    Next j
                End If
            End If
        Next i
    End With
    MsgBox "DODANO line kodu.", vbInformation, "POTWIERDZENIE..."
Else
    MsgBox "Anulowano."
End If
End Sub

Usuwanie linii kodu VBA działa podobnie. Podajemy kodowi nazwę modułu w którym mają być usunięte linie kodu. Jeżeli uruchomimy kod to w zależności od licznika zostanie usunięta odpowiednia ilość znaków. Także zanim uruchomisz kod usuwania linii kodu upewnij się, że oznaczenia linii zostały wcześniej dodane.

Usuwanie linii wierszy automatycznie:

' Uwaga: Trzeba dodać referencję
' Microsoft Visual Basic for Applications Extensibility 5.3.

' Ź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 RemoveLineNumber()
' USUWANIE LINII KODU

Dim i As Long, j As Long, lineN As Long
Dim procName As String
Dim startOfProceedure As Long
Dim lengthOfProceedure As Long
Dim ModuleName As String
Dim ReplaceJump, LineValue, PrevLineValue, LenLine, YesNo

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

YesNo = MsgBox("Czy chcesz USUNAC linie kodu z modulu:   '" & ModuleName & "'?", vbQuestion + vbYesNo, "PYTANIE...")
If YesNo = 6 Then
    With ThisWorkbook.VBProject.VBComponents(ModuleName).CodeModule
        For i = 1 To .CountOfLines
            procName = .ProcOfLine(i, vbext_pk_Proc)
            If procName <> vbNullString Then
                startOfProceedure = .ProcStartLine(procName, vbext_pk_Proc)
                If i = startOfProceedure Then
                    lengthOfProceedure = .ProcCountLines(procName, vbext_pk_Proc)
                    For j = 2 To lengthOfProceedure - 2
                        lineN = startOfProceedure + j

                        ' ----------------------------
                        ' WYŁACZENIA
                        
                        LineValue = .Lines(lineN, 1)
                        PrevLineValue = .Lines(lineN - 1, 1)
                        
                        If Len(.Lines(lineN, 1)) = 0 Then
                            .ReplaceLine lineN, .Lines(lineN, 1)
                            GoTo ReplaceJump
                        End If
                        
                        If Right(PrevLineValue, 1) = "_" Then
                            .ReplaceLine lineN, Right(.Lines(lineN, 1), Len(.Lines(lineN, 1)) - 8)
                            GoTo ReplaceJump
                        End If
                        
                        If Right(LineValue, 1) = ":" Then
                            GoTo ReplaceJump
                        End If
                        
                        If Left(Trim(LineValue), 4) = "Case" Then
                            .ReplaceLine lineN, Right(.Lines(lineN, 1), Len(.Lines(lineN, 1)) - 8)
                        End If
                        
                        If Left(Trim(LineValue), 6) = "Public" Then
                            GoTo ReplaceJump
                        End If
                        
                        If Left(Trim(LineValue), 7) = "Private" Then
                            GoTo ReplaceJump
                        End If
                        
                        If Left(Trim(LineValue), 3) = "Sub" Then
                            GoTo ReplaceJump
                        End If
    
                        If Left(Trim(LineValue), 3) = "Debug" Then
                            GoTo ReplaceJump
                        End If
                        
                        If Left(Trim(LineValue), 8) = "Function" Then
                            GoTo ReplaceJump
                        End If
                        
                        If Left(Trim(LineValue), 12) = "End Function" Then
                            GoTo ReplaceJump
                        End If
                        
                        If Left(Trim(LineValue), 7) = "End Sub" Then
                            GoTo ReplaceJump
                        End If
                        
                        If Left(Trim(LineValue), 7) = "" Then
                            GoTo ReplaceJump
                        End If
                        
                        If Left(Trim(LineValue), 1) = "'" Then
                            .ReplaceLine lineN, Right(.Lines(lineN, 1), Len(.Lines(lineN, 1)) - 8)
                            GoTo ReplaceJump
                        End If
                        
                        ' ----------------------------
                        ' USUWANIE NUMERU WIERSZA
                        
                        .ReplaceLine lineN, Right(.Lines(lineN, 1), Len(.Lines(lineN, 1)) - 8)
    
ReplaceJump:
                    Next j
                End If
            End If
        Next i
    End With
    MsgBox "USUNIETO line kodu.", vbInformation, "POTWIERDZENIE..."
Else
    MsgBox "Anulowano."
End If
End Sub

1 myśl w temacie “Dodawanie numerów linii do kodu VBA

  1. Pingback: Automatyczne dodawanie numeracji wierszy do modułu VBA | Moja baza danych Excel

Dodaj komentarz

Twój adres email nie zostanie opublikowany. Wymagane pola są oznaczone *

Witryna wykorzystuje Akismet, aby ograniczyć spam. Dowiedz się więcej jak przetwarzane są dane komentarzy.