VBA - Найти все пронумерованные линии в модулях VBE с помощью поиска по шаблону
Задача:
Моя цель - найти все пронумерованные строки в процедурах моих модулей кода. Метод CodeModule.Find можно использовать для проверки условий поиска (целевой параметр).
Синтаксис:
объект.Найти(target, startline, startcol, endline, endcol [, wholeword] [, matchcase] [, patternsearch])
Ссылающийся справочный сайт https://msdn.microsoft.com/en-us/library/aa443952(v=vs.60).aspx сообщает: параметр patternsearch: Необязательно. Логическое значение, указывающее, является ли целевая строка шаблоном регулярного выражения. Если True, целевая строка является шаблоном регулярного выражения. Ложь по умолчанию.
Как объяснено выше, метод find позволяет выполнять поиск по шаблону регулярных выражений, который я хотел бы использовать для точной идентификации пронумерованных строк: цифр и табуляции. Поэтому в приведенном ниже примере определяется строка поиска s и устанавливается последний параметр PatternSearch в методе.Find, равный True.
Проблема AFAIK правильное определение регулярного выражения может быть
s = "[0-9]{1,4}[ \t]"
но это ничего не показывает, даже ошибки.
Чтобы показать хотя бы какие-то результаты, я определил поисковый запрос
s = "[0-9]*[ \t]*)"
в вызывающем примере процедуры ListNumberedLines показаны ошибочные результаты.
Вопрос
Есть ли возможность использовать действительный поиск по шаблону в методе CodeModule.Find?
Пример кода
Option Explicit
' ==============
' Example Search
' ==============
Sub ListNumberedLines()
' Declare search pattern string s
Dim S As String
10 S = "[0-9]*[ \t]*)"
20 Debug.Print "Search Term: " & S
30 Call findWordInModules(S)
End Sub
Public Sub findWordInModules(ByVal sSearchTerm As String)
' Purpose: find modules ('components') with lines containing a search term
' Method: .CodeModule.Find with last parameter patternsearch set to True
' Based on https://www.devhut.net/2016/02/24/vba-find-term-in-vba-modulescode/
' VBComponent requires reference to Microsoft Visual Basic for Applications Extensibility
' or keep it as is and use Late Binding instead
' Declare module variable oComponent
Dim oComponent As Object 'VBComponent
For Each oComponent In Application.VBE.ActiveVBProject.VBComponents
If oComponent.CodeModule.Find(sSearchTerm, 1, 1, -1, -1, False, False, True) = True Then
Debug.Print "Module: " & oComponent.Name 'Name of the current module in which the term was found (at least once)
'Need to execute a recursive listing of where it is found in the module since it could be found more than once
Call listLinesinModuleWhereFound(oComponent, sSearchTerm)
End If
Next oComponent
End Sub
Sub listLinesinModuleWhereFound(ByVal oComponent As Object, ByVal sSearchTerm As String)
' Purpose: list module lines containing a search term
' Method: .CodeModule.Find with last parameter patternsearch set to True
Dim lTotalNoLines As Long 'total number of lines within the module being examined
Dim lLineNo As Long 'will return the line no where the term is found
lLineNo = 1
With oComponent ' Module
lTotalNoLines = .CodeModule.CountOfLines
Do While .CodeModule.Find(sSearchTerm, lLineNo, 1, -1, -1, False, False, True) = True
Debug.Print vbTab & "Zl. " & lLineNo & "|" & _
Trim(.CodeModule.Lines(lLineNo, 1)) 'Remove any padding spaces
lLineNo = lLineNo + 1 'Restart the search at the next line looking for the next occurence
Loop
End With
End Sub
3 ответа
Вывод относительно CodeModule.Find через шаблон поиска
Во-первых, CodeModule.Find не помогает через шаблон поиска, и его возможное использование непрозрачно. Я согласен с тем, что API VBIDE чрезвычайно ограничен и что существуют отличные профессиональные инструменты, которые я настоятельно рекомендую любому программисту:-)
Следствие: обойти через XML
Во-вторых, я предпочитаю бытовые средства, если это возможно, поэтому я попытался найти альтернативное решение, используя только полезные части VBIDE.
Метод Вот почему я попробовал простой XML-диалог CodeModule.Lines, позволяющий гибкий поиск в логических строках. Вместо использования регулярных выражений при запросе данных xml, я демонстрирую метод поиска начальных чисел с помощью четко определенного поиска XPath (цикл по списку узлов), что позволяет решить большинство проблем, отображаемых @ThunderFrame. Строка поиска в функции showErls определяется как "line[substring(translate(.,'0123456789','¹¹¹¹¹¹¹¹¹¹'),1,1)="¹"]"
Кроме того, функция 'lineNumber' возвращает номер логической строки в модуле.Примечание. Для простоты поиск ограничивается только одним модулем (определяемая пользователем константа MYMODULE), а код избегает регулярных выражений.
Обойти код - основной саб
Option Explicit
' ==========================================
' User defined name of module to be analyzed
' ==========================================
Const MYMODULE = "modThunderFrame" ' << change to existing module name or userform
' Declare xml file as object
Dim xCMods As Object ' Late Binding; instead of Early Bd: Dim xCMods As MSXML2.DOMDocument6
Public Sub TestLineNumbers()
' =================
' A. Load/refresh code into xml
' =================
' set xml into memory - contains code module(s) lines
Set xCMods = CreateObject("MSXML2.Domdocument.6.0") ' L.Bd.; instead of E.Bd: Set xCMods = New MSXML2.DOMDocument60
xCMods.async = False
xCMods.validateOnParse = False
' read in user defined code module and load xml, if failed show error message
refreshCM MYMODULE
If xCMods Is Nothing Then Exit Sub
' ======================
' B. search line numbers
' ======================
showERLs
' =============================
' C. Save xml if needed
' =============================
' xCMods.Save ThisWorkbook.Path & "\VBE(" & MYMODULE & ").xml"
' MsgBox "Successfully exported Excel data to " & ThisWorkbook.Path & "\VBE(" & MYMODULE & ").XML!", _
' vbInformation, "Module " & MYMODULE & " to xml"
' =================
' D. terminate xml
' =================
Set xCMods = Nothing
End Sub
Подпроцедуры
Private Sub showERLs()
' Purpose: [B.] declare XPath search string and define special translate character
Dim s As String
Dim S1 As String: S1 = Chr(185) ' superior number 1 (hex B9) replaces any digit
' declare node and node list
Dim line As Object
Dim lines As Object
' define XPath search string for first digit in line (usual case)
s = "line[substring(translate(.,'0123456789','" & String(10, S1) & "'),1,1)=""" & _
S1 & _
"""]"
' start debugging
Debug.Print "**search string=""" & s & """" & vbNewLine & String(50, "-")
Debug.Print "Line #|Line Content" & vbNewLine & String(50, "-"); ""
' set node list
Set lines = xCMods.DocumentElement.SelectNodes(s)
' -------------------
' loop thru node list
' -------------------
For Each line In lines
Debug.Print Format(lineNumber(line), "00000") & "|" & line.Text ' return logical line number plus line content
Next line
End Sub
Private Sub refreshCM(sModName As String)
' Purpose: [A.] load xml string via LoadXML method
Dim sErrTxt As String
Dim line As Object
Dim lines As Object
Dim xpe As Object
Dim s As String ' xpath expression
Dim pos As Integer ' position of line number prefix
' ======================================
' 1. Read code module lines and load xml
' ======================================
If Not xCMods.LoadXML(readCM(sModName)) Then
' set ParseError object
Set xpe = xCMods.parseError
With xpe
sErrTxt = sErrTxt & vbNewLine & String(20, "-") & vbNewLine & _
"Loading Error No " & .ErrorCode & " of xml file " & vbCrLf & _
Replace(" " & Replace(.URL, "file:///", "") & " ", " ", "[No file found]") & vbCrLf & vbCrLf & _
xpe.reason & vbCrLf & _
"Source Text: " & .srcText & vbCrLf & _
"char?: " & """" & Mid(.srcText, .linepos, 1) & """" & vbCrLf & vbCrLf & _
"Line no: " & .line & vbCrLf & _
"Line pos: " & .linepos & vbCrLf & _
"File pos.: " & .filepos & vbCrLf & vbCrLf
End With
MsgBox sErrTxt, vbExclamation, "XML Loading Error"
Set xCMods = Nothing
Exit Sub
End If
' 2. resolve hex input problem of negative line numbers with leading space (thx @Thunderframe)
s = "line"
Set lines = xCMods.DocumentElement.SelectNodes(s)
' loop thru all logical lines
For Each line In lines
pos = ErlPosInLine(line.Text)
If pos <= Len(line.Text) Then
' to do: add attribute to line node, if wanted
' correct line content
line.Text = Mid(line.Text, pos)
End If
Next
End Sub
Private Function lineNumber(node As Object) As Long
' Purpose: [B.] return logical line number within code module lines
' Param.: IXMLDomNode
' Method: XPath via preceding-sibling count plus one
Dim tag As String: tag = "line"
lineNumber = node.SelectNodes("preceding-sibling::" & tag).Length + 1
End Function
Private Function readCM(Optional modName = "*") As String
' Purpose: return code module line string (VBIDE) of a user defined module to be read into xml
' Call: called from [A.] refreshCM
' xCMods.LoadXML(readCM(sModName))
' Declare variable
Dim s As String
Dim md As CodeModule
If modName = "*" Then Exit Function
On Error GoTo OOPS
' get code module lines into string
Set md = Application.VBE.ActiveVBProject.VBComponents(modName).CodeModule ' MSAccess: Modules("modVBELines")
' change to xml tags
s = getTags(md.lines(1, md.CountOfLines))
' return
readCM = s
OOPS:
End Function
Private Function getTags(ByVal s As String, Optional mode = False) As String
' Purpose: prepares xml string to be loaded
' define constant
Const HEAD = "<?xml version=""1.0"" encoding=""utf-8""?>" & vbCrLf & "<cm>" & vbCrLf
' 1. change tag characters
s = Replace(Replace(s, "<", "<"), ">", ">")
' 2. change special characters (ampersand)
s = Replace(s, "&", "&")
' 3. change "_" points
s = Replace(s, "_" & vbCrLf, Chr(133) & vbLf)
' 4. define logical line entities
If Right(s, 2) = vbCrLf Then s = Left(s, Len(s) - 2)
s = HEAD & " <line>" & Replace(s, vbCrLf, "</line>" & vbCrLf & " <line>") & "</line>" & vbCrLf & "</cm>"
' debug xml tags if second function parameter is true (mode = True)
If mode Then Debug.Print s
' return
getTags = s
End Function
Sub testErlPosInLine()
' Purpose: Test Thunderframe's problem with ERL prefixes (underscores, " ",..) and hex inputs
Dim s As String
s = " _" & vbLf & " -1 xx"
MsgBox "|" & Mid(s, ErlPosInLine(s)) & "|" & vbNewLine & _
"prefix = |" & Mid(s, 1, ErlPosInLine(s) - 1) & "|"
End Sub
Private Function ErlPosInLine(ByVal s As String) As Integer
' Purpose: remove prefix (underscore, tab, " ",.. ) from numbered line
' cf: http://stackru.com/questions/42716936/vba-to-remove-numbers-from-start-of-string-cell
Dim i As Long
For i = 1 To Len(s) ' loop each char
Select Case Mid$(s, i, 1) ' examine current char
Case " " ' permitted chars
Case "_"
Case vbLf, Chr(133), Chr(34)
Case "0" To "9": Exit For ' cut off point
Case Else: Exit For ' i is the cut off point
End Select
Next
If Mid$(s, i, 1) = "-" And Len(s) > 1 Then
If IsNumeric(Mid$(s, i + 1, 1)) Then i = i + 1
End If
' return
ErlPosInLine = i
' debug.print Mid$(s, i) '//strip lead
End Function
Как говорит @MatsMug, синтаксический анализ VBA с помощью Regex трудно сделать невозможным, но номера строк - более простой случай, и их можно найти только с помощью regex.
К счастью, номера строк могут появляться только в теле процедуры (в том числе до End Sub/Function/Property заявление), поэтому мы знаем, что они никогда не будут первой строкой вашего кода.
К сожалению, вы можете поставить префикс строки с 0 или более продолжениями строки:
Sub Foo()
_
_
10 Beep
End Sub
Кроме того, за номером строки не всегда следует пробел - за ним может следовать разделитель инструкций, в результате чего номер строки выглядит как метка строки:
Sub foo()
10: Beep
End Sub
И если ваш код злой, вы можете встретить отрицательный номер строки (введенный с использованием шестнадцатеричной записи - который VBE покорно печатает обратно на панель кода с начальным пробелом и отрицательным числом):
Sub foo()
10 Beep
-1 Beep
End Sub
И нам также нужно иметь возможность идентифицировать числа, которые появляются в непрерывной строке, которые не являются номерами строк:
Sub foo()
Debug.Print _
5 & "is not a line-number"
End Sub
Итак, вот некоторая злая нумерация строк со смесью всех этих крайних случаев:
Option Explicit
Sub foo()
5: Beep
_
_
_
10 Beep
20 _
'Debug.Print _
30
50: Beep
40 Beep
_
-1 _
Beep 'The "-1" line number is achieved by entering "&HFFFFFFFF"
Debug.Print _
2 & "is not a line-number"
60 End Sub
И вот несколько регулярных выражений, которые идентифицируют номера строк:
(?<! _)\n( _\n)* ?(?<line_number>(?:\-)?\d+)[: ]
А вот подсветка синтаксиса от regex101:
Долгое время Rubberduck боролся с правильным / формальным анализом номеров строк - наш обходной путь заключался в их удалении (замене пробелами) перед передачей содержимого модуля кода в наш анализатор.
Недавно нам удалось формально определить номера строк:
// lineNumberLabel should actually be "statement-label" according to MS VBAL but they only allow lineNumberLabels:
// A <statement-label> that occurs as the first element of a <list-or-label> element has the effect
// as if the <statement-label> was replaced with a <goto-statement> containing the same
// <statement-label>. This <goto-statement> takes the place of <line-number-label> in
// <statement-list>.
listOrLabel :
lineNumberLabel (whiteSpace? COLON whiteSpace? sameLineStatement?)*
| (COLON whiteSpace?)? sameLineStatement (whiteSpace? COLON whiteSpace? sameLineStatement?)*
;
sameLineStatement : blockStmt;
А также lineNumberLabel определяется как:
//Statement labels can only appear at the start of a line.
statementLabelDefinition : {_input.La(-1) == NEWLINE}? (combinedLabels | identifierStatementLabel | standaloneLineNumberLabel);
identifierStatementLabel : unrestrictedIdentifier whiteSpace? COLON;
standaloneLineNumberLabel :
lineNumberLabel whiteSpace? COLON
| lineNumberLabel;
combinedLabels : lineNumberLabel whiteSpace identifierStatementLabel;
lineNumberLabel : numberLiteral;
(полная грамматика Antlr4 здесь)
Обратите внимание на предикат {_input.La(-1) == NEWLINE}?, которые заставляют правило синтаксического анализатора соответствовать только statementLabelDefinition в начале строки - логическая строка кода.
Вы видите, что код VBA имеет физические строки кода, как то, что вы получаете от CodeModule содержание. Но код VBA также имеет концепцию логических строк кода, и оказывается, что это все, что заботит парсер.
Это отключило бы любое типичное регулярное выражение:
Sub DoSomething()
Debug.Print _
42
End Sub
Есть только 1 логическая строка кода между подписью и End Sub жетон, но простой Find с удовольствием посмотрим, что 42 как "номер строки"... что это не так - это аргумент, переданный Debug.Print в той же инструкции, в той же строке логического кода, но в следующей строке физического кода.
И вы не можете иметь дело с логическими строками кода без предварительной предварительной обработки ввода, чтобы учесть токены продолжения строки.
И для того, чтобы сделать это, вам нужно проанализировать инструкции, которые вы видите - по крайней мере, знать, где они начинаются и где они заканчиваются... и это немалая задача! увидеть ответ ThunderFrame
API VBIDE чрезвычайно ограничен и не поможет в этом.
TL; DR: Вы не можете анализировать код VBA только с помощью регулярных выражений. Так что нет. Сожалею! вам нужен гораздо более сложный шаблон регулярных выражений, чем этот - см. ответ ThunderFrame.