如何使用变量在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 /中完成...这样文本.Parent.Line.Visible可以从变量(或单元格值)中提取,而不是硬编码？

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

编辑:我发现Access的MSDN信息提到了Eval,但是当我执行我的代码时它会显示"未定义的子或函数",指向Eval(Excel似乎不知道这个函数).

编辑2:在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.

动态添加代码.
不要这样做.这是错误的,它需要具有"允许访问VB项目"标记集.

添加引用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