VBA-将Excel中的Word表格填充为下拉列表

Question

让我首先说我对VBA一点经验都没有；尽管我很想成为，但我边学习边学习，后来，我不知道我不知道什么。除了把事情拼凑在一起，我很难找到有效的教育材料，所以任何帮助都将不胜感激。

我有一个表，我将称之为"客户数据"。在该表中，我有五个单元格，需要使用定期更新的excel电子表格中的轮询数据自动填充："客户ID"、"客户名称"、"经理"、"支持联系人"one_answers"订阅日期"。"客户端ID"应该生成一个下拉框，根据用户在该下拉框中选择的内容，剩余的单元格应该填充该ID的上下文数据。任何关于我可以从哪里开始的建议或指针都会非常有帮助。

谢谢！

编辑：

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") & "DocumentsClient 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

Answer 1

这是用于制作自动完成下拉菜单的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