У меня есть презентация в 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

0
Michał Zaręba 8 Июл 2017 в 19:22
Вы пробовали изменить параметры функции фильтра на CompareMethod.Text или CompareMethod.binary?
 – 
Lowpar
8 Июл 2017 в 20:08

2 ответа

Вы можете использовать объект 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))
0
Domenic 8 Июл 2017 в 21:05

Прежде всего, ответ - «да», вы можете получить доступ к этим массивам по имени. Вы бы использовали функцию CallByName(), которая позволяет вам получить доступ к любому свойству (и, действительно, методу) объекта по его имени, переданному в виде строки.

Небольшая корректировка, которую вам нужно будет внести в свой код, - это создать объект, который содержит массивы как свойства. В частности, вы должны сделать это, вставив объект Class (Insert> Class Module). В приведенном ниже примере я вызвал класс 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
0
Ambie 9 Июл 2017 в 03:54