VBA - заполнить таблицу Word из Excel как выпадающие списки - PullRequest
0 голосов
/ 27 февраля 2020

Позвольте мне начать с того, что я совсем не знаком с VBA; хотя я хотел бы быть, я учусь как я go, и впоследствии я не знаю, чего я не знаю. Я с трудом нахожу эффективные учебные материалы, кроме того, что собираю все по кусочкам, поэтому любая помощь там будет высоко цениться.

У меня есть таблица, которую я буду называть «Данные клиента». В этой таблице у меня есть пять ячеек, которые мне нужно автоматически заполнить данными, опрошенными из регулярно обновляемой электронной таблицы Excel: «Идентификатор клиента», «Имя клиента», «Менеджер», «Контакт поддержки» и «Дата подписки». «Идентификатор клиента» должен генерировать раскрывающийся список, и в зависимости от того, что пользователь выбирает в этом раскрывающемся списке, оставшиеся ячейки должны заполняться контекстными данными для этого идентификатора. Любой совет или указатели на то, где я могу начать, очень помогли бы.

Спасибо!

Редактировать :

Sub Document_Open()
    Application.ScreenUpdating = False
    Dim xlApp As New Excel.Application, xlWkBk As Excel.Workbook
    Dim StrWkBkNm As String, StrWkShtNm As String, LRow As Long, i As Long
    StrWkBkNm = "C:\Users\" & Environ("Username") & "\Documents\Client List.xlsx"
    StrWkShtNm = "Client List"
    If Dir(StrWkBkNm) = "" Then
        MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
        Exit Sub
    End If
    With xlApp
        .Visible = False
        Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm, ReadOnly:=True, AddToMRU:=False)
    With xlWkBk
    With .Worksheets(StrWkShtNm)
        LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        ActiveDocument.SelectContentControlsByTitle("ID")(1).DropdownListEntries.Clear
        For i = 2 To LRow
        ActiveDocument.SelectContentControlsByTitle("ID")(1).DropdownListEntries.Add _
            Text:=Trim(.Range("A" & i))
        Next
    End With
        .Close False
    End With
        .Quit
    End With
        Set xlWkBk = Nothing: Set xlApp = Nothing
        Application.ScreenUpdating = True
End Sub

1 Ответ

0 голосов
/ 28 февраля 2020

вот код VBA для создания раскрывающегося списка автозаполнения и для заполнения другой ячейки в соответствии с выбранным раскрывающимся списком, вы можете просто использовать следующую формулу Excel-

=IFERROR(VLOOKUP(A2,K2:L8,2,),"") 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim xCombox As OLEObject
    Dim xStr As String
    Dim xWs As Worksheet
    Dim xArr

    Set xWs = Application.ActiveSheet
    On Error Resume Next
    Set xCombox = xWs.OLEObjects("TempCombo")
    With xCombox
        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False
    End With
    If Target.Validation.Type = 3 Then
        Target.Validation.InCellDropdown = False
        Cancel = True
        xStr = Target.Validation.Formula1
        xStr = Right(xStr, Len(xStr) - 1)
        If xStr = "" Then Exit Sub
        With xCombox
            .Visible = True
            .Left = Target.Left
            .Top = Target.Top
            .Width = Target.Width + 5
            .Height = Target.Height + 5
            .ListFillRange = xStr
            If .ListFillRange = "" Then
                xArr = Split(xStr, ",")
                Me.TempCombo.List = xArr
            End If
            .LinkedCell = Target.Address
        End With
        xCombox.Activate
        Me.TempCombo.DropDown
    End If
End Sub
Private Sub TempCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Select Case KeyCode
        Case 9
            Application.ActiveCell.Offset(0, 1).Activate
        Case 13
            Application.ActiveCell.Offset(1, 0).Activate
    End Select
End Sub
...