很多时候，我们要处理一些未知的模块。比如预先写的函数，无法预料将来要应用到哪里。
这个函数执行前先检查以下，应用的模块是否有相应的资源（常量、过程、函数）
上代码：
'检查模块中，是否有相应的公共Sub/Function
Public Function ScanModuleSub(Sub_Name As String, Module As Module, Optional IsFunction As Boolean = False) As Boolean
'Sub_Name=过程/函数名
'Module=模块
'IsFunction=是否是函数。True=Function;False=Sub
ScanModuleSub = False
On Error GoTo err1
Dim SubName As String, SubTxt As String
SubName = "ScanModuleSub"
SubTxt = "检查模块中，是否有相应的公共Sub/Function"
Sub_Name = Trim(Sub_Name)
If Module Is Nothing or Sub_Name = "" Then GoTo err1
Dim i As Long, Code As String, Ftxt As String, Ftxt2 As String
Dim sz() As String
If IsFunction Then
Ftxt = "Public Function " & Sub_Name & "("
Else
Ftxt = "Public Sub " & Sub_Name & "("
End If
Ftxt = UCase(Ftxt)
Ftxt2 = Replace(Ftxt, "PUBLIC ", "") '无关键词 Public
For i = 1 To Module.CountOfLines '逐行读取
Code = Module.Lines(i, 1)
'Debug.Print i & "# " & Code
Code = Trim(Code)
If Code = "" or Left(Code, 1) = "'" Then GoTo Next1 '跳过注释语句
sz = Split(Code, "'")
Code = Trim(sz(0)) '剔除 注释
Code = UCase(Left(Code, Len(Ftxt)))
If Code = Ftxt or Left(Code, Len(Ftxt2)) = Ftxt2 Then
ScanModuleSub = True
Exit Function
End If
Next1:
Next
Exit Function
err1:
Call ErrMsBox(SubName, SubTxt & " 失败!")
End Function
'提取模块中所有公共Sub/Function词典
Public Function PublicSubDic(Module As Module) As Scripting.Dictionary
'Module=模块
Set PublicSubDic = Nothing
On Error GoTo err1
Dim SubName As String, SubTxt As String
SubName = "PublicSubDic"
SubTxt = "提取模块中所有公共Sub/Function词典"
If Module Is Nothing Then GoTo err1
Dim Dic As New Scripting.Dictionary
Dic.CompareMode = 1 'TextCompare 文本比较 不区分大小写
Dim i As Long, Code As String, Txt0 As String, Txt1 As String
Dim RowTxt As String, Name As String, ParamS As String, Retun As String, Typ As String
Dim sz() As String, sz1() As String
For i = 1 To Module.CountOfLines '逐行读取
Code = Module.Lines(i, 1)
'Debug.Print i & "# " & Code
Code = Trim(Code)
If Code = "" or Left(Code, 1) = "'" Then GoTo Next1 '跳过 注释行
sz = Split(Code, "'")
RowTxt = Trim(sz(0)) '剔除注释，获取有效行字符
sz1 = Split(RowTxt, "(")
Txt0 = Trim(sz1(0)) '名称部分
If InStr(Txt0, "Sub ") > 0 Then
sz = Split(Txt0, "Sub ")
Typ = "Sub" '类型
ElseIf InStr(Txt0, "Function ") > 0 Then
sz = Split(Txt0, "Function ")
Typ = "Function" '类型
Else
GoTo Next1 '跳过 没有Sub/Function的语句
End If
Txt1 = Trim(sz(0)) '访问限制
Name = Trim(sz(1)) '名称
If InStr(Txt1, "Private") > 0 Then GoTo Next1 '跳过 私有
If UBound(sz1) >= 1 Then '参数部分
'分解参数
sz = Split(sz1(1), ")")
ParamS = Trim(sz(0)) '参数串
If UBound(sz) >= 1 Then '返回部分
Retun = Replace(sz(1), "As", "")
Retun = Trim(Retun)
Else
Retun = ""
End If
Else
ParamS = ""
Retun = ""
End If
Dim dc As New Scripting.Dictionary
dc("Name") = Name '名称
dc("RowTxt") = RowTxt '行字符
dc("Type") = Typ '类型
dc("ParamS") = ParamS '参数串
dc("Return") = Retun '返回
Set Dic(Name) = dc
Next1:
Next
Set PublicSubDic = Dic
Exit Function
err1:
Call ErrMsBox(SubName, SubTxt & " 失败!")
End Function
'从模块中读取指定常量值
Public Function GetConst(Module As Module, ConstName As String) As String
'Module=模块
'ConstName=常量名
GetConst = ""
On Error GoTo err1
Dim SubName As String, SubTxt As String
SubName = "GetConst"
SubTxt = "从模块中读取指定常量值"
If Module Is Nothing Then GoTo err1
Dim Txt1 As String, Txt2 As String
Txt1 = "MeTab = "
Txt2 = "Const MeTab "
Dim i As Long, Code As String, UCode As String
Dim sz() As String
For i = 1 To Module.CountOfLines '逐行读取
Code = Module.Lines(i, 1)
'Debug.Print i & "# " & Code
Code = Trim(Code)
If Code = "" or Left(Code, 1) = "'" Then GoTo Next1 '跳过 注释语句
sz = Split(Code, "'")
Code = Trim(sz(0)) '剔除 注释
If Code = "" Then GoTo Next1 '跳过 空语句
If InStr(1, Code, "=") <= 0 Then GoTo Next1 '跳过 非赋值语句
If InStr(1, Code, Txt1, 1) > 0 Then '忽略大小写
'Function
ElseIf InStr(1, Code, Txt2, 1) > 0 Then '忽略大小写
'Const
sz = Split(Code, ",")
Code = Trim(sz(0)) '第一个Const
Else
GoTo Next1
End If
sz = Split(Code, "=")
Code = Trim(sz(1)) '等号右侧 字符串
If InStr(1, Code, """") <= 0 Then GoTo Next1 '跳过 非"XX"语句
sz = Split(Code, """")
Code = Trim(sz(1)) '引号内 字符串
If Code <> "" Then '返回
GetConst = Code
Exit Function
End If
Next1:
Next
Exit Function
err1:
Call ErrMsBox(SubName, SubTxt & " 失败!")
End Function
