Visual Basic for Applications/检查工作簿是否包含 VBA 代码
外观
这个 VBA 代码模块是为 Excel 制作的,但很容易适应其他 MS Office 应用程序。它检查工作簿以查看它是否包含任何有用的 VBA *维* 或 *结构* 代码。行计数已被发现不如此可靠,因为即使是空的模块也会显示两行代码。
- 将以下所有代码放入同一个标准模块中,并在 *wb* 中标识测试工作簿地址。
- 然后,运行过程 *CheckForVBA* 以检查测试工作簿是否包含可识别的 VBA 代码结构。
- 这些过程首先检查工作簿是否未锁定。
- 用户可以在过程 *ContainsVBAKeyWords* 中修改测试关键字列表。
- 检查后,测试工作簿将再次关闭。
- 结果将在此处显示在消息框中,但顶部部分很容易修改以用于其他用途。
Option Explicit
Sub CheckForVBA()
'Run this procedure to know whether a specified workbook has VBA code
'Assumes that workbook to test is in same folder and called Book2.xlsm
'Set reference to Microsoft VBA Extensibility 5.5
Dim wb As Workbook, nL As Long, bR As Boolean
'set full address of workbook to test here
'if just file name then same folder is assumed
Set wb = Workbooks.Open("Book2.xlsm")
'check for code if project is not locked
If IsProtectedVBProject(wb) = False Then
'check for vba code
If WbkHasVBA(wb) = True Then
MsgBox "Workbook " & wb.FullName & vbCrLf & _
"CONTAINS VBA code structure."
Else
MsgBox "Workbook " & wb.FullName & vbCrLf & _
"DOES NOT contain VBA code structure."
End If
Else
MsgBox "The VBA Project is LOCKED;" & vbCrLf & _
"might have VBA but unable to confirm."
End If
'close the test workbook
wb.Close
End Sub
Function IsProtectedVBProject(ByVal wb As Workbook) As Boolean
'returns TRUE if VBA is password protected, else false
Dim nComp As Integer
nComp = -1
On Error Resume Next
nComp = wb.VBProject.VBComponents.Count
On Error GoTo 0
If nComp = -1 Then
IsProtectedVBProject = True
Else
IsProtectedVBProject = False
End If
End Function
Private Function WbkHasVBA(ByVal wb As Workbook) As Boolean
'returns true if workbook contains VBA, else false.
'Code must not be locked.
'Set reference to Microsoft VBA Extensibility 5.5
Dim VBComp As VBIDE.VBComponent
Dim VBMod As VBIDE.CodeModule
Dim nLines As Long, sMod As String
'get each module one at a time
For Each VBComp In wb.VBProject.VBComponents
Set VBMod = VBComp.CodeModule
nLines = VBMod.CountOfLines
If nLines <> 0 Then
sMod = VBMod.Lines(1, nLines)
'check for significant code entries
If ContainsVBAKeyWords(sMod) Then
WbkHasVBA = True
Exit For
End If
End If
Next VBComp
Set VBComp = Nothing
Set VBMod = Nothing
End Function
Function ContainsVBAKeyWords(ByVal sModule As String) As Boolean
'Returns true if input string contains any listed word,
'else false. User should add keywords of interest to vKeyList
Dim vKeyList As Variant, nC As Integer, bM As Boolean
'set the key list of interest here
vKeyList = Array("End", "Dim", "Public", "Private", "Friend", "Property", _
"Type", "Declare", "Sub", "Function")
'loop through keylist and compare with parameter module string
For nC = LBound(vKeyList) To UBound(vKeyList)
bM = sModule Like "*" & vKeyList(nC) & "*"
If bM = True Then
ContainsVBAKeyWords = True
Exit For
End If
Next nC
End Function