使用字符串引用vba中的数组名称

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

首先，答案是肯定的，你可以按名称访问这些阵列。您可以使用CallByName()函数，该函数使您能够通过名称传递对象的任何属性（实际上是方法），并以字符串的形式传递。

您需要对代码进行的小调整是创建一个包含数组作为属性的对象。具体来说，你可以通过插入一个Class对象（插入>类模块）来实现。在下面的例子中，我称为类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