使用字符串引用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