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 mikerickson. Trochę 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
Pingback: Automatyczne dodawanie numeracji wierszy do modułu VBA | Moja baza danych Excel