Question

我有Powerpoint演示文稿。在每张幻灯片上，我有8个带文本空间的形状。它们可以包含表示与内容/数据更新等相关的组的文本。我有以下数组，其中包含这些责任区域的用户：

GEN = Array("username_01","username_02","username_03",..."username_xx")
POL = Array("username_01","username_02","username_03",..."username_xx")
B2B = Array("username_01","username_02","username_03",..."username_xx")
RUS = Array("username_01","username_02","username_03",..."username_xx")

这个函数检查用户是否在数组

   Function IsInArray(stringToBeFound As Variant, arr As Variant) As Boolean
   IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
   End Function

我的问题是，当我想使用该功能时，它只有在我给出如下的数组名称时才有效：

auser = Environ("UserName")
IsInArray(auser,GEN) 'it will give me answer if the user is in array

我想获得形状文字：

res_group_txt = ActivePresentation.Slides(i).Shapes(shape_owner).TextEffect.Text

并以某种方式将其放在函数中，因此它不会返回错误

auser = Environ("UserName")
IsInArray(auser,res_group_txt)

我试图改变变量并查看所有主题，但我没有找到答案:(

帮助请：）

BR Misza

Answer 1

您可以使用Dictionary对象将文本映射到数组...

Dim oDic As Object
Dim GEN As Variant
Dim POL As Variant
Dim B2B As Variant
Dim RUS As Variant

GEN = Array("username_01", "username_02", "username_03")
POL = Array("username_01", "username_02", "username_03")
B2B = Array("username_01", "username_02", "username_03")
RUS = Array("username_01", "username_02", "username_03")

Set oDic = CreateObject("Scripting.Dictionary")
oDic.comparemode = vbTextCompare

oDic("GEN") = GEN
oDic("POL") = POL
oDic("B2B") = B2B
oDic("RUS") = RUS

然后你可以按如下方式调用你的函数......

IsInArray(auser, oDic(res_group_txt))

Answer 2

首先，答案是＆＃39;是＆＃39;，您可以按名称访问这些数组。您可以使用CallByName()函数，它允许您通过名称访问对象的任何属性（实际上是方法），并以字符串形式传递。

您需要对代码进行的小调整是创建一个包含数组作为属性的对象。具体来说，您可以通过插入Class对象（插入＆gt;类模块）来完成此操作。在下面的示例中，我调用了类 cArrayFields 并添加了您的代码，如下所示：

Option Explicit

Public GEN As Variant
Public POL As Variant
Public B2B As Variant
Public RUS As Variant

Private Sub Class_Initialize()
    GEN = Array("username_01", "username_02", "username_03", "username_04")
    POL = Array("username_02", "username_03", "username_04")
    B2B = Array("username_03", "username_04")
    RUS = Array("username_04")
End Sub

在您的主程序（模块中的程序）中，您的代码只是：

Dim o As cArrayFields
Dim targetShape As Shape
Dim targetName As String, shapeText As String, aUser As String
Dim arr As Variant
Dim i As Long


targetName = "MyShape"
aUser = "username_03" 'test example

Set o = New cArrayFields
For i = 1 To 4
    Set targetShape = ActivePresentation.Slides(i).Shapes(targetName)
    shapeText = targetShape.TextEffect.Text
    arr = CallByName(o, shapeText, VbGet)
    Debug.Print IsInArray(aUser, arr)
Next

但是，我想知道您的用户和职责是否以最有效的方式构建。更直观的方法可能是拥有一个用户列表，每个成员都包含他们负责的区域列表。如果你这样做，那么查找会简单得多;例如，您可以使用Collection对象，该对象通过String键访问每个项目。所以你的代码可能只是一些小例程来创建列表：

Private Sub DefineUserList()
    Set mUsers = New Collection

    AddNewUser "username_01", "GEN"
    AddNewUser "username_02", "GEN", "POL"
    AddNewUser "username_03", "GEN", "POL", "B2B"
    AddNewUser "username_04", "GEN", "POL", "B2B", "RUS"
End Sub
Private Sub AddNewUser(userName, ParamArray respAreas() As Variant)
    Dim resp As Collection
    Dim v As Variant

    Set resp = New Collection
    For Each v In respAreas
        resp.Add True, CStr(v)
    Next
    mUsers.Add resp, userName

End Sub

然后您的主模块中的查找例程如下：

Option Explicit

Private mUsers As Collection

Public Sub Main()
    Dim targetShape As Shape
    Dim targetName As String, shapeText As String, aUser As String
    Dim i As Long


    DefineUserList

    targetName = "MyShape"
    aUser = "username_03" 'test example

    For i = 1 To 4
        Set targetShape = ActivePresentation.Slides(i).Shapes(targetName)
        shapeText = targetShape.TextEffect.Text
        Debug.Print IsUsersArea(aUser, shapeText)
    Next
End Sub

Private Function IsUsersArea(userName As String, respArea As String) As Boolean
    On Error Resume Next
    IsUsersArea = mUsers(userName).Item(respArea)
    On Error GoTo 0
End Function

使用string来引用vba中的数组名称

2 个答案: