如何使用变量来设置VBA中的属性(Excel)

时间:2021-08-10 15:09:46

Take this code:

把这段代码:

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

Is there any VBA way to "execute" or "evaluate" like can be done in perl/python/... such that the text .Parent.Line.Visible can be drawn from a variable (or cell value), rather than hard coded?

在perl/python/…这样,文本。parent。line。可见可以从变量(或单元格值)中绘制,而不是硬编码?

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

EDIT: I found MSDN information for Access that mentions Eval, but when I execute my code it says "Undefined Sub or Function", pointing at Eval (Excel does not seem to know this function).

编辑:我找到了用于访问的MSDN信息,其中提到了Eval,但当我执行代码时,它说“未定义子或函数”,指向Eval (Excel似乎不知道这个函数)。

EDIT 2: Found the definitive (negative) answer on SO.

编辑2:找到最终的(否定的)答案。

EDIT 3: Seems like there is an answer after all, as I am not after a general solution for arbitrary code execution. Thanks to GSerg for helping with using CallByName.

编辑3:似乎总有一个答案,因为我并不是在寻找一个通用的代码执行解决方案。感谢GSerg帮助使用CallByName。

3 个解决方案

#1


10  

Solution 1.

Use CallByName.

使用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

Usage:

用法:

? 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

Solution 2.

Dynamically add code.
Don't do this. It's wrong and it requires having that "Allow access to VB project" tick set.

动态添加代码。不要这样做。这是错误的,它要求有“允许访问VB项目”的标记集。

Add a reference to Microsoft Visual Basic for Applications Extensibility X.X.

为应用程序可扩展性x . x添加对Microsoft Visual Basic的引用。

Create a module called ModuleForCrap.

创建一个名为moduleforshit的模块。

Add a dynamically constructed sub/function:

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

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

Call it:

叫它:

msgbox application.run("ModuleForCrap.foobar")

Delete it:

删除:

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

#2


1  

You could try looking at CallByName, but I don't think it's going to do what you want (at least, not easily if you're going to want to evaluate multi-dot object/property references).

您可以尝试查看CallByName,但我认为它不会做您想做的事情(至少,如果您想要评估多点对象/属性引用,这并不容易)。

#3


0  

False evaluates to Zero. You can construct an integer variable to equate to zero and have it turn out the same way as False.

错误的评估为零。您可以构造一个整型变量,使其等于零,并使其结果与False相同。

#1


10  

Solution 1.

Use CallByName.

使用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

Usage:

用法:

? 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

Solution 2.

Dynamically add code.
Don't do this. It's wrong and it requires having that "Allow access to VB project" tick set.

动态添加代码。不要这样做。这是错误的,它要求有“允许访问VB项目”的标记集。

Add a reference to Microsoft Visual Basic for Applications Extensibility X.X.

为应用程序可扩展性x . x添加对Microsoft Visual Basic的引用。

Create a module called ModuleForCrap.

创建一个名为moduleforshit的模块。

Add a dynamically constructed sub/function:

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

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

Call it:

叫它:

msgbox application.run("ModuleForCrap.foobar")

Delete it:

删除:

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

#2


1  

You could try looking at CallByName, but I don't think it's going to do what you want (at least, not easily if you're going to want to evaluate multi-dot object/property references).

您可以尝试查看CallByName,但我认为它不会做您想做的事情(至少,如果您想要评估多点对象/属性引用,这并不容易)。

#3


0  

False evaluates to Zero. You can construct an integer variable to equate to zero and have it turn out the same way as False.

错误的评估为零。您可以构造一个整型变量,使其等于零,并使其结果与False相同。