add-in zur Zeilennummerierung in VBA

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Test() Dim x As Long, y As Long 10 On Error GoTo Fehler 20 x = 20 30 y = 99 - 99 40 x = x / y 50 MsgBox "Zahl: " & x Ende: 60 Exit Sub Fehler: 70 MsgBox "Es trat der Fehler... '" & Err.Description & "' auf.", _ vbCritical, "Fehler in Zeile " & Erl 80 Resume Ende End Sub

Sub MakroNummerieren() Dim vbc As Object Dim iRow As Integer, iCol As Integer, iCounter As Integer, iNumber As Integer Dim bol Sub As Boolean Dim strNumber As String bol Sub = False For Each vbc In ActiveWorkbook.VBProject.VBComponents With vbc.CodeModule For iCounter = 1 To .CountOfLines If .ProcOfLine(iCounter, 0) > "" Then If .Lines(iCounter, 1) Like "Sub*" Then bol Sub = True iNumber = 10 strNumber = Format(iNumber, "000000") & ":" GoTo next_iCounter End If If .Lines(iCounter, 1) = "End Sub " Then bol Sub = False GoTo next_iCounter End If If bol Sub = True Then If Right(.Lines(iCounter - 1, 1), 1) <> "_" Then .replaceline iCounter, strNumber & .Lines(iCounter, 1) iNumber = iNumber + 10 strNumber = Format(iNumber, "000000") & ":" End If End If End If next_iCounter: Next iCounter End With Next vbc End Sub Gruß Geist ist geil!

Danke.
Eigentlich nicht schlecht.
Klappt aber in der Form nur beim ersten mal. (Neunummerierung müsste erst die alten Nummern entfernen).
Ich werde mich mal bemühen, das hinzubekommen.
Kommentar- und Leerzeilen auslassen wäre auch noch schön.
Lange Nacht.
Stefan.

Hallo Sefan,
ist doch garnicht so schwer:
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public Sub Zeilennummerierung()
    Dim intModulCount As Integer, intLine As Integer
    Dim intColumn As Integer, intLineCounter As Integer
    Dim strModulname As String
    Dim bolUnderscore As Boolean, bolSelect As Boolean
    With ActiveWorkbook.VBProject
        For intModulCount = 1 To .VBComponents.Count
            With .VBComponents(intModulCount).CodeModule
                For intLine = .CountOfDeclarationLines + 1 To .CountOfLines
                    If Trim$(.Lines(intLine, 1)) <> "" And _
                        Left$(Trim$(.Lines(intLine, 1)), 1) <> "'" Then
                        If .ProcOfLine(intLine, 0) <> strModulname Then
                            strModulname = .ProcOfLine(intLine, 4)
                            intLineCounter = 0
                            If Left$(Trim$(StrReverse(.Lines(intLine, 1))), 1) = "_" _
                                Then bolUnderscore = True Else bolUnderscore = False
                        Else
                            If InStr(1, "End Sub End Function End Property", _
                                .Lines(intLine, 1)) = 0 Then
                                If Not bolUnderscore And Not bolSelect Then
                                    If Left$(Trim$(StrReverse(.Lines(intLine, 1))), 1) = "_" Then _
                                        bolUnderscore = True
                                    If InStr(1, .Lines(intLine, 1), "Select Case") <> 0 Then _
                                        bolSelect = True
                                    If IsNumeric(Left$(.Lines(intLine, 1), 1)) Then
                                        For intColumn = 1 To Len(.Lines(intLine, 1))
                                            If Not IsNumeric(Left$(.Lines(intLine, 1), intColumn)) Then
                                                Exit For
                                            End If
                                        Next
                                        .ReplaceLine intLine, String(intColumn - 1, " ") & _
                                            Mid$(.Lines(intLine, 1), intColumn)
                                    End If
                                    intLineCounter = intLineCounter + 1
                                    If Trim$(Left$(.Lines(intLine, 1), _
                                        Len(Trim(intLineCounter)) + 2)) = "" Then
                                        .ReplaceLine intLine, Mid$(.Lines(intLine, 1), _
                                            Len(Trim(intLineCounter)) + 2)
                                    Else
                                        .ReplaceLine intLine, Trim$(.Lines(intLine, 1))
                                    End If
                                    .ReplaceLine intLine, Trim$(CStr(intLineCounter)) & " " _
                                        & .Lines(intLine, 1)
                                Else
                                    If Left$(Trim$(StrReverse(.Lines(intLine, 1))), 1) <> "_" _
                                        Then bolUnderscore = False
                                    If InStr(1, .Lines(intLine, 1), "Case") <> 0 Then _
                                        bolSelect = False
                                End If
                            Else
                                strModulname = ""
                            End If
                        End If
                    End If
                Next
            End With
        Next
    End With
End Sub

Gruß
Nepumuk
Excel & VBA Beispiele

cool.
Schwer nicht, aber ich hätte trotzdem Stunden gebraucht.
Außerdem habe ich ab Verschachtelungstiefe 10 so meine Probleme. Und die nicht nur beim Sprechen.
Gruß, Dank und schönes Wochenende.
Stefan Krähe

Beliebteste Forumthreads (12 Monate)

add-in zur Zeilennummerierung in VBA

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread