Numerowanie linii kodu i wykorzystanie funkcji VBA.ERL   strona główna:
A po co ten Excel ;-)
 
 
    Budujemy obsługę błędów w naszej procedurze. Procedura podczas pracy zwraca nieraz błąd zwracając informację na temat danego  
błędu. Np.: Err.Number ; Err.Description Jednak w której linii nastąpił błąd? Do realizacji tego zadania potrzebna nam jest właśnie  
Funkcja ERL. Funkcja ta znajduje się w tzw. Hiden Members.  Oznacza to że Miscrosoft nie gwarantuje że funkcja ta będzie dostępna  
w kolejnych wersjach programu jednak w E2010 nadal jest :-)  
    Żeby jednak funkcja działała w procedurze linie muszą być ponumerowane. Tj. procedura musi wyglądać tak:  
 
Sub CreateQry(strConnection As String, _  
              strQueryName As String, _  
              strSQL As String)  
                                        
10    On Error GoTo CreateQry_Error  
    Dim Catalog As Object 'ADOX.Catalog  
    Dim objCommand As Object 'ADODB.Command  
           
20    Set Catalog = CreateObject("ADOX.Catalog") ' New ADOX.Catalog  
30    Set objCommand = CreateObject("ADODB.Command") ' New ADODB.Command  
           
40    Catalog.ActiveConnection = strConnection  
50    Set objCommand.ActiveConnection = Catalog.ActiveConnection  
           
60    objCommand.CommandText = strSQL  
70    Catalog.Procedures.Append strQueryName, objCommand  
       
CreateQry_Exit:  
80    On Error Resume Next  
90    CloseConObject Catalog.ActiveConnection  
100    Set objCommand = Nothing  
110    Exit Sub  
       
CreateQry_Error:  
120    MsgBox "Błąd nr - " & Err.Number & vbCrLf & vbCrLf & _  
           Err.Description & vbCrLf & vbCrLf & _  
           "Wystapił w linii: " & VBA.Erl, vbExclamation, "VBAProject - CreateQry"  
130    Resume CreateQry_Exit
 
End Sub  
 
Wywołanie takiej procedury z w.w. obsługą błędów skutkuje np.: takim błędem:  
Jak jednak nadać te numery dla linii kodu?  
 
Najprostszym sposobem jest wykorzystanie narzedzia "MZ-Tools".  
W dokumentacji tego dodatku można przeczytać:  
 
"Line Numbering
 
You can add or remove line numbers to a procedure, module, project or project   
group through the corresponding context menu in the Project Explorer.   
This feature is useful if you use the (undocumented) Erl function in your   
error handlers to know the line that caused the error. You can define in the   
Options window the increment used and if global numbers should be used."   
 
Dodatek można ściągnąć z:  
Download of MZ-Tools 3.0 for Visual Basic 6.0, 5.0 and VBA  
 
Jednak bywa że przez politykę naszej firmy nie możemy instalować na naszym komputerze niczego bez zezwolenia Admina, a tego  
prosić… Szkoda czasu i nerwów ;-) co w takiej sytuacji? Możemy napisac procedurę która będze realizować to zadanie. :-)  
 
Przykładem takie procedury nadającej numery linią kodu dla wybranego modułu (Module2) mogłaby wyglądać tak:  
 
Option Explicit  
 
Sub SetLineNr()  
    Dim vbCodeModule As Object 'VBIDE.CodeModule  
    Dim i As Long  
      
    On Error GoTo SetLineNr_Error  
      
    Dim iNr As Long: iNr = 10  
      
    Set vbCodeModule = ThisWorkbook.VBProject.VBComponents("Module2").CodeModule  
    With vbCodeModule  
        For i = .CountOfDeclarationLines + 1 To .CountOfLines  
            Dim strLine As String: strLine = VBA.Trim(.Lines(i, 1))  
              
            If Len(strLine) > 0 Then  
              
                If strLine Like "Sub * _" Or _  
                   strLine Like "Function * _" Or _  
                   strLine Like "Public Sub * _" Or _  
                   strLine Like "Public Function * _" Or _  
                   strLine Like "Private Sub * _" Or _  
                   strLine Like "Private Function * _" Then  
                    Do  
                        i = i + 1  
                        strLine = VBA.Trim(.Lines(i, 1))  
                        If Not strLine Like "* _" Then  
                            i = i + 1  
                            Exit Do  
                        End If  
                    Loop  
                End If  
              
                strLine = VBA.Trim(.Lines(i, 1))  
                  
                If Not (strLine Like "Dim *" Or _  
                        strLine Like "Const *" Or _  
                        strLine Like "Static *" Or _  
                        strLine Like "*:" Or _  
                        strLine Like "'*" Or _  
                        Len(strLine) = 0) Or _  
                  (strLine Like "Dim *:*") Then  
      
                    If strLine Like "Sub *" Or _  
                       strLine Like "Function *" Or _  
                       strLine Like "Public Sub *" Or _  
                       strLine Like "Public Function *" Or _  
                       strLine Like "Private Sub *" Or _  
                       strLine Like "Private Function *" Then  
      
                        iNr = 10  
      
                    ElseIf strLine = "End Sub" Or _  
                           strLine = "End Function" Then  
                             
                        iNr = 0  
                          
                    Else  
                        Dim bFlagA As Boolean  
      
                        If strLine Like "* _" Then bFlagA = True  
      
                        strLine = iNr & .Lines(i, 1)  
                        .DeleteLines i, 1  
                        .InsertLines i, strLine  
                          
                        If bFlagA Then  
                            Do  
                                i = i + 1  
                                strLine = VBA.Trim(.Lines(i, 1))  
                                If Not strLine Like "* _" Then Exit Do  
                            Loop  
                            bFlagA = False  
                        End If  
      
                        iNr = iNr + 10  
                    End If  
                End If  
            End If  
        Next  
    End With  
      
SetLineNr_Exit:  
    On Error GoTo 0  
    Set vbCodeModule = Nothing  
    Exit Sub  
 
SetLineNr_Error:  
    MsgBox "Error " & Err.Number & _  
        " (" & Err.Description & ") in procedure SetLineNr of Module Module1"  
    Resume SetLineNr_Exit  
      
End Sub  
 
Fragmentami:  
 
    Dim vbCodeModule As Object 'VBIDE.CodeModule  
    Set vbCodeModule = ThisWorkbook.VBProject.VBComponents("Module2").CodeModule  
 
Do napisania tej procedury wykorzystywałem (bo później przerobiłem na późne wiązanie - więc już nie wykorzystuję ;-) ) bibliotekę:  
Microsoft Visual Basic for Applications Extensibility 5.3  
 
ustawienie referencji do tej biblioteki ułatwi nam pisanie procedur opartych o obiekty tej biblioteki przez uzyskanie dostępu do  
podpowiedzi. Zachęcam zatem do nadania referencji a po napisanie procedury przeróbkę kodu na późne wiązanie.  
 
    With vbCodeModule  
        For i = .CountOfDeclarationLines + 1 To .CountOfLines  
 
Pętlę po liniach kodu zaczynam od linii poniżej części deklaracji modułu.  
 
            Dim strLine As String: strLine = VBA.Trim(.Lines(i, 1))  
              
Oczyszczam linię kodu Funkcją Trim. Ułatwi to nadawanie warunków kiedy kod jest formatowany odstępami od lewej (tabami)  
 
                If strLine Like "Sub * _" Or _  
                   strLine Like "Function * _" Or _  
                   strLine Like "Public Sub * _" Or _  
                   strLine Like "Public Function * _" Or _  
                   strLine Like "Private Sub * _" Or _  
                   strLine Like "Private Function * _" Then  
                    Do  
                        i = i + 1  
                        strLine = VBA.Trim(.Lines(i, 1))  
                        If Not strLine Like "* _" Then  
                            i = i + 1  
                            Exit Do  
                        End If  
                    Loop  
                End If  
 
Chodzi o zapis typu:  
Sub CreateQry(strConnection As String, _  
              strQueryName As String, _  
              strSQL As String)  
 
Te linie nie powinny być numerowane. A więc jeżeli linia jest np.: Like "Sub * _" to ani ta, ani kolejne linie nie będą numerowane. Aż   
procedura natrafi na linię nie spełniającą warunku Like "* _" co oznacza że nie ma już kolejnej linii początku procedury.  
 
                If Not (strLine Like "Dim *" Or _  
                        strLine Like "Const *" Or _  
                        strLine Like "Static *" Or _  
                        strLine Like "*:" Or _  
                        strLine Like "'*" Or _  
                        Len(strLine) = 0) Or _  
                  (strLine Like "Dim *:*") Then  
 
Procedura nie powinna numerować lini jak:   
 - "Dim *", "Const *", "Static *" - linie deklaracji zmiennych.  
 - "*:" - etykiet (np.: SetLineNr_Exit:)  
 - "'*" - komentarzy  
 - ani pustych linii  
Jednak powinna numerować np.: coś takiego:  
Dim i As Long: i = 15  
 
                    If strLine Like "Sub *" Or _  
                       strLine Like "Function *" Or _  
                       strLine Like "Public Sub *" Or _  
                       strLine Like "Public Function *" Or _  
                       strLine Like "Private Sub *" Or _  
                       strLine Like "Private Function *" Then  
      
                        iNr = 10  
 
Jeżeli linia zaczyna się w.w. początkiem (bez _) to oznacza to początek nadawania numeracji. Numerowanie zaczynamy od 10.  
 
                    ElseIf strLine = "End Sub" Or _  
                           strLine = "End Function" Then  
                             
                        iNr = 0  
 
Takie linie oznaczają koniec liczenia i żeby przygotować zmienną iNr do nadawania liczb kolejnej procedurze zmienną zerujemy.  
 
                        strLine = iNr & .Lines(i, 1)  
                        .DeleteLines i, 1  
                        .InsertLines i, strLine  
 
Wszystkie inne linie numerujemy. Jednak niektóre linie też mogą być podzielone przez _ Wtedy:  
 
                        If strLine Like "* _" Then bFlagA = True  
 
                        If bFlagA Then  
                            Do  
                                i = i + 1  
                                strLine = VBA.Trim(.Lines(i, 1))  
                                If Not strLine Like "* _" Then Exit Do  
                            Loop  
                            bFlagA = False  
                        End If  
 
numerujemy tylko pierwszą linię i przechodzimy dalej aż warunek Not Like "* _" zostanie spełniony.  
 
I chyba tyle. :-)