vba - 如何在 VBA (Excel) 中使用变量设置属性

Question

获取此代码:

With ActiveSheet.Shapes.AddShape(msoShapeRectangle, x, y, w, h).TextFrame
  .Parent.Line.Visible = False
  .Parent.Fill.ForeColor.RGB = RGB(r, g, b)
End With

是否有任何 VBA 方法可以像在 perl/python/... 中那样“执行”或“评估”，以便可以从变量(或单元格值)，而不是硬编码？

ParentLine = ".Parent.Line.Visible"
ParentLineValue = "False"

With ActiveSheet.Shapes.AddShape(msoShapeRectangle, x, y, w, h).TextFrame
  **eval**(ParentLine & "=" & ParentLineValue)
  .Parent.Fill.ForeColor.RGB = RGB(r, g, b)
End With

编辑:我发现MSDN information for Access它提到了 Eval，但是当我执行代码时，它显示“未定义的子或函数”，指向 Eval(Excel 似乎不知道这个函数)。

编辑2:找到definitive (negative) answer on SO .

编辑3:似乎毕竟有一个答案，因为我并不追求任意代码执行的通用解决方案。感谢 GSerg 帮助使用 CallByName。

Answer 1

解决方案 1。

使用CallByName。

Option Explicit

Private Type Callable
  o As Object
  p As String
End Type

Public Sub SetProperty(ByVal path As String, ByVal Value As Variant, Optional ByVal RootObject As Object = Nothing)
  With GetObjectFromPath(RootObject, path)
    If IsObject(Value) Then
      CallByName .o, .p, VbSet, Value
    Else
      CallByName .o, .p, VbLet, Value
    End If
  End With
End Sub

Public Function GetProperty(ByVal path As String, Optional ByVal RootObject As Object = Nothing) As Variant
  With GetObjectFromPath(RootObject, path)
    GetProperty = CallByName(.o, .p, VbGet)
  End With
End Function

Public Function GetPropertyAsObject(ByVal path As String, Optional ByVal RootObject As Object = Nothing) As Object
  With GetObjectFromPath(RootObject, path)
    Set GetPropertyAsObject = CallByName(.o, .p, VbGet)
  End With
End Function


Private Function GetObjectFromPath(ByVal RootObject As Object, ByVal path As String) As Callable
  'Returns the object that the last .property belongs to
  Dim s() As String
  Dim i As Long

  If RootObject Is Nothing Then Set RootObject = Application

  Set GetObjectFromPath.o = RootObject

  s = Split(path, ".")

  For i = LBound(s) To UBound(s) - 1
    If Len(s(i)) > 0 Then
      Set GetObjectFromPath.o = CallByName(GetObjectFromPath.o, s(i), VbGet)
    End If
  Next

  GetObjectFromPath.p = s(UBound(s))
End Function

用法:

? getproperty("activecell.interior.color")
16777215 

SetProperty "activecell.interior.color", vbYellow
'Sets yellow background

? getproperty("names.count", application.ActiveWorkbook)
0 

? getproperty("names.count", GetPropertyAsObject("application.activeworkbook"))
0

<小时/>

解决方案 2。

动态添加代码。
不要这样做。这是错误的，它需要 "Allow access to VB project"勾选设置。

添加对 Microsoft Visual Basic for Applications Extensibility X.X 的引用。

创建一个名为ModuleForCrap的模块。

添加动态构造的子/函数:

ThisWorkbook.VBProject.VBComponents("ModuleForCrap").CodeModule.AddFromString _
"function foobar() as long" & vbNewLine & _
"foobar = 42" & vbNewLine & _
"end function"`

调用它:

msgbox application.run("ModuleForCrap.foobar")

删除它:

With ThisWorkbook.VBProject.VBComponents("ModuleForCrap").CodeModule
  .DeleteLines .ProcStartLine("foobar", vbext_pk_Proc), .ProcCountLines("foobar", vbext_pk_Proc)
End With