Пользовательская функция Excel для заполнения строки - PullRequest
0 голосов
/ 17 июня 2019

У меня есть настраиваемая функция Excel `GetADUser ', которая принимает имя пользователя в качестве входных данных и возвращает несколько атрибутов Active Directory, таких как Имя, Фамилия, Имя учетной записи SAM, Отличительное имя.

Как я могу получить эти атрибуты в ячейки слева и справа от ячейки, которая содержит форум? а именно:

enter image description here

Public Function GetADUser(UserName As String) As String

Dim mycell As Range

Set rootDSE = GetObject("LDAP://RootDSE")

Base = "<LDAP://" & rootDSE.Get("defaultNamingContext") & ">"
'filter on user objects with the given account name
fltr = "(&(objectClass=user)(objectCategory=Person)" & _
        "(sAMAccountName=" & UserName & "))"
'add other attributes according to your requirements
attr = "distinguishedName,sn,mobile,sAMAccountName,GivenName,l,postOfficeBox"
Scope = "subtree"

Set conn = CreateObject("ADODB.Connection")
conn.Provider = "ADsDSOObject"
conn.Open "Active Directory Provider"

Set cmd = CreateObject("ADODB.Command")
Set cmd.ActiveConnection = conn
cmd.CommandText = Base & ";" & fltr & ";" & attr & ";" & Scope

  Set rs = cmd.Execute

  arrPOBox = rs.Fields("postOfficeBox").Value
  Rank = CStr(arrPOBox(0))

  ActiveCell.Offset(0, -1).Value = (rs.Fields("sn").Value)
  ActiveCell.Offset(0, -2).Value = (rs.Fields("GivenName").Value)
  ActiveCell.Offset(0, 2).Value = (rs.Fields("l").Value)
  ActiveCell.Offset(0, 1).Value = (rs.Fields("mobile").Value)

rs.Close
conn.Close

GetADUser = GetADUser

End Function

Однако ActiveCell недоступен в функциях.

Я прочитал способ вернуть вариант вместо String, но он задействовал CTRL-SHIFT-ENTER, чтобы разделить значения, которые все шли справа от ячейки, содержащей формулу. Я не хочу звонить в Active Directory для каждой ячейки.

Существует ли функция или процедура, которая может быть реализована таким образом, чтобы при выходе пользователя из ячейки в столбце имени пользователя заполнялись другие относительные ячейки.

UPDATE

Это должно было быть подробно описано в исходном вопросе, но ячейки с именами пользователей могут быть на любом листе рабочей книги, а не в виде непрерывного набора ячеек в одном из четырех возможных столбцов. (см., например, желтые ячейки)

enter image description here

Имена листов также могут быть изменены.

Метод Пересечение имеет предел (30) для диапазонов, которые он может принять.

Я рассмотрел регулярное выражение, поскольку имя пользователя всегда [a-z] {4} [a-z] {2}, но затем оно срабатывает в каждой ячейке.

Как бы я сделал пересечение?

1 Ответ

1 голос
/ 18 июня 2019

Примерно так:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, c As Range

    'any updates to username(s)?
    Set rng = Application.Intersect(Me.Range("C2:C1000"), Target)
    If Not rng Is Nothing Then
        Application.EnableEvents = False '<< don't re-trigger the event
        For Each c In rng.Cells
            UpdateAdInfo c  'update the row for this user
        Next c
        Application.EnableEvents = True '<< re-enable events
    End If
End Sub




Public Sub UpdateAdInfo(rngUserName As Range)

    'clear existing data
    rngUserName.EntireRow.Range("A1:B1,D1:E1").ClearContents '<< note range is relative to row, not to sheet

    If Len(rngUserName.Value) = 0 Then Exit Sub 'no username entered, or was deleted

    '...
    '...snipped for clarity: open the recordset using rngUserName.Value
    '...

    Set rs = cmd.Execute

    With rngUserName.EntireRow
        .Cells(1).Value = rs.Fields("GivenName").Value
        .Cells(2).Value = rs.Fields("sn").Value
        'etc etc
    End With

    rs.Close
    conn.Close
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...