用字符串调用function

Question

Private Sub EvalFunc() 
  '' 创建函数。 
  Dim Sc As New ScriptControl 
  Sc.Language = "VBScript" 
    Dim strFunction As String 
    strFunction = _ 
      "Function ReturnThis(x, y)" & vbCrLf & _ 
        " ReturnThis = x * y" & vbCrLf & _ 
    "End Function" 
    Debug.Print strFunction 
  '' 添加代码，然后运行该函数。 
    Sc.AddCode strFunction 
      MsgBox Sc.Run("ReturnThis", 3, 25) 
End Sub 
这段程序是用VBScript技术,通过用字符串技术来创建function函数,    Sc.AddCode strFunction ---将代码植入到VB程序------这种理解对否???请教各位大侠的正确理解?
      MsgBox Sc.Run("ReturnThis", 3, 25) 运行功能函数.在VB程序中,有如下function函数.
Function ReturnThis(x, y) 
  ReturnThis = x * y 
End Function 
目标需求
用字符串来执行 ReturnThis(2,3),得到的结果为6    Sc.AddCode strFunction 
      MsgBox Sc.Run("ReturnThis", 3, 25) 
也就是这两段语句,如何改能实现ReturnThis(2,3)返回结果为 6的目标需求.谢谢.

Answer 1

一、增加模块 1．增加一个模块，命名为“我的模块”   ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule).Name = "我的模块"   系统常量vbext_ct_StdModule=1 2．增加一个类模块，命名为“我的类”   ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_ClassModule).Name = "我的类"   vbext_ct_ClassModule=2 3．增加一个窗体，命名为“我的窗体”   ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm).Name = "我的窗体"   vbext_ct_MSForm=3 二、删除模块 1．删除“模块1”
  ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents("模块1") 2．删除窗体“UserForm1”
  ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents("UserForm1") 3．删除类模块“类1”
  ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents("类1") 4.删除所有的窗体 Sub RmvForms()   Dim vbCmp As VBComponent   For Each vbCmp In ThisWorkbook.VBProject.VBComponents     If vbCmp.Type = vbext_ct_MSForm Then ThisWorkbook.VBProject.VBComponents.Remove vbCmp   Next vbCmp End Sub   相关：   工作表和ThisWorkbook的模块类型为vbext_ct_Document=100 三、增加代码 1.在“模块1”中插入代码 如果需要在“Sheet1”、“Thisworkbook”、或“Userform1”中操作，用只需将下面的“模块1”换成相应的名称即可。 方法1： 在模块的开始增加代码，增加的代码放在公共声明option,全局变量等后面。 Sub AddCode1()  ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.AddFromString _    "sub aTest()" & Chr(10) & _    "msgbox ""Hello""" & Chr(10) & _    "end sub" End Sub 方法2： 在模块指定行处增加代码，原代码后移。增加代码不理会和判断插入处代码的内容。当指定行大于最后一行行号时，在最后一行的后面插入。 Sub AddCode2()   With ThisWorkbook.VBProject.VBComponents("模块1").CodeModule     .InsertLines 1, "sub aTest()"     .InsertLines 2, "msgbox ""Hello"""     .InsertLines 3, "end sub"   End With End Sub 
 
相关语句： (1)“模块1”中代码总行数： ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.CountOfLines (2)“模块1”中代码公共声明部分的行数： ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.CountOfDeclarationLines (3)显示“模块1”中第1行起的3行代码内容： Sub ShowCodes()   Dim s$   s = ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.Lines(1, 3)   Debug.Print s End Sub (4)过程aTest的起始行数： ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.ProcBodyLine("aTest", vbext_pk_Proc) ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.ProcStartLine("aTest", 0) 系统常量vbext_pk_Proc=0 二者的区别是ProcBodyLine返回sub aTest或Function aTest所在的行号，如果sub前面有空行，ProcStartLine返回空行的行号。 (5)过程aTest的总行数： ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.ProcCountLines("aTest", vbext_pk_Proc) 2.建立事件过程 建立事件过程除了使用上面的代码如下面的AddEventsCode1外，还可以使用CreateEventProc方法，如AddEventsCode2所示。 一般方法： Sub AddEventsCode1()   ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.AddFromString _     "Private Sub Workbook_Open()" & Chr(13) & _     "MsgBox ""Hello""" & Chr(13) & _     "End Sub" End Sub CreateEventProc方法： Sub AddEventsCode2()   Dim i%   With ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule     i = .CreateEventProc("SelectionChange", "Worksheet") + 1     .InsertLines i, "Msgbox ""Hello"""   End With End Sub 上面CreateEventProc的两个参数建立的事件过程为Worksheet_SelectionChange，分别是下划线两边的内容。 相关： 测试是否存在SelectionChange事件 下面函数测试模块modulname是否存在过程subname，如果存在，则返回起始行号，否则返回0。 debug.print hassub("Worksheet_SelectionChange","Sheet1") Function HasSub(ByVal subname As String, ByVal modulname As String) As Long   On Error Resume Next   Dim i&   i = ThisWorkbook.VBProject.VBComponents(modulname).CodeModule.ProcBodyLine(subname, 0)   If Err.Number = 35 Then     Err.Clear     HasSub = 0   Else     HasSub = i   End If End Function 如果存在，则返回起始行号，否则返回0。 
 
四、删除代码 1．删除Sheet1中第2行起的三行代码： 如果只删除1行代码，第二个参数可省略。 Sub DelCodes()  ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule.DeleteLines 2, 3 End Sub 2．删除“模块1”的所有代码： Sub DelCodes()  With ThisWorkbook.VBProject.VBComponents("模块1").CodeModule    .DeleteLines 1, .CountOfLines  End With End Sub 3．删除过程aTest: Sub DelCodes()   With ThisWorkbook.VBProject.VBComponents("模块1").CodeModule    .DeleteLines . ProcStartLine("aTest", 0), .ProcCountLines("aTest", 0)   End With End Sub
4．将“模块1”的第5行代码替换为“x=3”  ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.ReplaceLine 5, "x=3" 五、引用项目 1．增加引用   ThisWorkbook.VBProject.References.AddFromFile "C:\Windows\System32\asctrls.ocx" 2．取消引用   ThisWorkbook.VBProject.References.Remove ThisWorkbook.VBProject.References("ASControls") 这里ASControls是引用的名字，即后面的rf.Name。 3．显示当前所有引用 Sub ShowRefs()   Dim rf As VBIDE.Reference   For Each rf In ThisWorkbook.VBProject.References     Debug.Print rf.Name, rf.FullPath   Next End Sub 六、信任及密码 上面所有操作都基于这样的前题： （1）EXCEL已设置： 工具（T）-宏（M）-安全性（M）-可靠发行商（T）-勾选了“信任对于VB项目的访问（V）” （2）工程没有设置密码 如果不能满足它们中的任何一个，代码运行就会出错。因为微软不希望我们对VBProject进行操作，我们无从知道这种操作的直接方法被藏到了什么地方。幸运的是，微软在关起正门的同时，还是为我们留了一道门：SendKeys。借助于这道后门和“错误陷阱”，我们仍可以完成我们所要做的事。 下面给出绕开这两道门的示意代码，如果你要运行它们，请记得切回EXCEL主界面，而不是在VBE中直接运行。 1．信任对于VB项目的访问 Sub SetAllowableVbe()   On Error Resume Next   Dim Chgset As Boolean   '陷阱测试，VBProject.Protection在这儿并无实际的意义   Debug.Print ThisWorkbook.VBProject.Protection   If Err.Number = 1004 Then     Err.Clear     Application.SendKeys "%TMS%T%V{ENTER}" Chgset = True DoEvents   End If   '要执行的操作....   '.....   '操作完成后还原操作前的状态   If Chgset Then Application.SendKeys "%TMS%T%V{ENTER}" End Sub 2．操作密码工程 Sub AllowPass()   Dim pw$   pw = "Password"   If ThisWorkbook.VBProject.Protection = vbext_pp_locked Then     Application.VBE.CommandBars(1).Controls("工具(T)").Controls("VBAProject 属性(&E)...").Execute     Application.SendKeys pw & "{ENTER}{ENTER}"     DoEvents   End If   '要执行的操作….   '..... End Sub Protection属性返回工程的受保护状态，vbext_pp_locked(1)为受保护,vbext_pp_none(0)表示没有保护。 

Answer 2

谢谢,楼上的解答,需要进一步消化.
Callbyname方法解决如下
在类模块中
Function ReturnThis(x, y)
   ReturnThis = x * y
End Function
在主程序中
Sub llss()
  s = CallByName(ll, "ReturnThis", VbMethod, 2, 3)
End Sub
目标实现.