如何使用变量在 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

False 的计算结果为零。您可以构造一个等于零的整数变量，并使其结果与 False 相同。

Answer 2

您可以尝试查看CallByName，但我认为它不会达到您想要的效果（至少，如果您想要评估多点对象/属性引用，这并不容易）。

Answer 3

解决方案 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