如何在VBA（Excel）中使用变量设置属性

Question

如何在VBA（Excel）中使用变量设置属性

10

请看这段代码：

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。

- asoundmove

我很好奇什么时候有人会想要这样做？ - Jean-François Corbett

我只是想将宏参数化，而不强迫用户阅读VBA，只需在他们的电子表格中进行操作。我意识到安全性方面的影响，但这仅限于有限的使用。可能需要设置不同的属性，或者选择其他替代方案。 - asoundmove

ScriptControl ActiveX 可以帮助您评估包含任何 Application 成员的字符串，请查看此答案。 - omegastripes

3个回答

1

你可以尝试查看 CallByName，但我认为它不会做你想要的事情（至少，如果你要评估多点对象/属性引用，那么不容易）。

- Tim Williams

很不错的尝试，但 ActiveSheet.Cells(x, y) 不支持 CallByName。 - asoundmove

现在我明白了，CallByName 只有一层。GSerg 的解决方案适用于多层。 - asoundmove

0

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

- Harry

好的，但我的问题比那个要基础得多。我编辑了我的问题以更精准地表达我的请求。我意识到这更像是一个支持性的问题，但我找不到相关信息的任何地方。 - asoundmove

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- GSerg · Accepted Answer

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