时间戳

首页 > 解决方案 > 使用 VBA 代码从 Excel 中填写 Word 中的数据。当我添加数据时，它对一个测试客户有效，但对其他客户无效，我不明白为什么

excel - 使用 VBA 代码从 Excel 中填写 Word 中的数据。当我添加数据时，它对一个测试客户有效，但对其他客户无效，我不明白为什么

问题描述

我正在尝试使用 VBA 代码将主 Excel 工作表中的数据提取到 Word 文档中，该文档将在开始时有一个客户下拉列表，然后将其余部分更改为依赖于该客户的数据.

我找到了一个示例，我复制并修改了它以适应我的需要（有点），但我不太了解为什么它可以使它正确。当我开始制作它时，我只有一位客户的数据，因此我使用该信息进行测试。但是，当我为其他客户填写一些数据时，我发现它对他们不起作用，只有第一个。我还注意到，当我在 Excel 工作表中添加另一列时，它告诉我下标超出范围。这让我相信代码是从过时的 Excel 表中获取数据，因此不包括更新版本，尽管我尽最大努力让它使用新版本。我希望这可以通过对我的代码进行一些小的调整来帮助，其中可能有我已经超出的指定范围的列。

我已经包含了我在下面使用的代码。如果您不知道我的问题的答案，我希望有人至少可以清理一下，因为示例中的一些内容不相关。

Option Explicit
Private Sub Document_ContentControlOnExit(ByVal oCC As ContentControl, Cancel As Boolean)
Dim arrData() As String
Dim strData As String
Dim lngIndex As Long
  Select Case oCC.Title
    Case "CC Conditional Dropdown List"
      With oCC
        If Not .ShowingPlaceholderText Then

          For lngIndex = 1 To .DropdownListEntries.Count
            If .Range.Text = .DropdownListEntries.Item(lngIndex) Then
              strData = .DropdownListEntries.Item(lngIndex).Value
              .Type = wdContentControlText
              .Range.Text = strData
              .Type = wdContentControlDropdownList
              Exit For
            End If
          Next lngIndex
        End If
      End With
     Case "Name"
      If Not oCC.ShowingPlaceholderText Then

        For lngIndex = 1 To oCC.DropdownListEntries.Count
          If oCC.Range.Text = oCC.DropdownListEntries.Item(lngIndex) Then

            arrData = Split(oCC.DropdownListEntries.Item(lngIndex).Value, "|")
            Exit For
          End If
        Next lngIndex

        With oCC
          .Type = wdContentControlText
          .Range.Text = arrData(0)
          .Type = wdContentControlDropdownList
        End With

        ActiveDocument.SelectContentControlsByTag("AM").Item(1).Range.Text = Replace(arrData(1), "~", Chr(11))
        ActiveDocument.SelectContentControlsByTag("CSA").Item(1).Range.Text = arrData(2)
        ActiveDocument.SelectContentControlsByTag("Contract").Item(1).Range.Text = arrData(3)
        ActiveDocument.SelectContentControlsByTag("Renewal").Item(1).Range.Text = arrData(4)
        ActiveDocument.SelectContentControlsByTag("CurrentHR").Item(1).Range.Text = arrData(5)
        ActiveDocument.SelectContentControlsByTag("RUG").Item(1).Range.Text = arrData(6)
        ActiveDocument.SelectContentControlsByTag("eRMI").Item(1).Range.Text = arrData(7)
        ActiveDocument.SelectContentControlsByTag("PurchasedHRSCBS").Item(1).Range.Text = arrData(8)
        ActiveDocument.SelectContentControlsByTag("PurchasedMODAMEJpeRMALOD").Item(1).Range.Text = arrData(9)
        ActiveDocument.SelectContentControlsByTag("ActualHRSCBS").Item(1).Range.Text = arrData(10)
        ActiveDocument.SelectContentControlsByTag("ActualMODAM").Item(1).Range.Text = arrData(11)
        ActiveDocument.SelectContentControlsByTag("ActualER").Item(1).Range.Text = arrData(12)
        ActiveDocument.SelectContentControlsByTag("ActualEJp").Item(1).Range.Text = arrData(13)
        ActiveDocument.SelectContentControlsByTag("ActualMedApp").Item(1).Range.Text = arrData(14)
        ActiveDocument.SelectContentControlsByTag("ActualLoD").Item(1).Range.Text = arrData(15)
        ActiveDocument.SelectContentControlsByTag("ERattainmentCons").Item(1).Range.Text = arrData(16)
        ActiveDocument.SelectContentControlsByTag("ERattainmentnon-Cons").Item(1).Range.Text = arrData(17)
        ActiveDocument.SelectContentControlsByTag("ERattainmentNwBN").Item(1).Range.Text = arrData(18)
        ActiveDocument.SelectContentControlsByTag("ERattainmentWBN").Item(1).Range.Text = arrData(19)
        ActiveDocument.SelectContentControlsByTag("ERattainmentAHPs").Item(1).Range.Text = arrData(20)
        ActiveDocument.SelectContentControlsByTag("ERattainmentPharm").Item(1).Range.Text = arrData(21)
        ActiveDocument.SelectContentControlsByTag("eJPAttainmentCons").Item(1).Range.Text = arrData(22)
        ActiveDocument.SelectContentControlsByTag("eJPAttainmentNonCons").Item(1).Range.Text = arrData(23)
        ActiveDocument.SelectContentControlsByTag("eJPAttainmentNWBN").Item(1).Range.Text = arrData(24)
        ActiveDocument.SelectContentControlsByTag("eJPAttainmentAHPs").Item(1).Range.Text = arrData(25)
        ActiveDocument.SelectContentControlsByTag("eJPAttainmentPharma").Item(1).Range.Text = arrData(26)
        ActiveDocument.SelectContentControlsByTag("AcademyHRPropSent").Item(1).Range.Text = arrData(27)
        ActiveDocument.SelectContentControlsByTag("AcademyHmPropSent").Item(1).Range.Text = arrData(28)
        ActiveDocument.SelectContentControlsByTag("AcademyHRPropReturned").Item(1).Range.Text = arrData(29)
        ActiveDocument.SelectContentControlsByTag("AcademyHMPropReturned").Item(1).Range.Text = arrData(30)
        ActiveDocument.SelectContentControlsByTag("AcademyHRcourses").Item(1).Range.Text = arrData(31)
        ActiveDocument.SelectContentControlsByTag("AcademyHMcourses").Item(1).Range.Text = arrData(32)
        ActiveDocument.SelectContentControlsByTag("AcademyHREntit").Item(1).Range.Text = arrData(33)
        ActiveDocument.SelectContentControlsByTag("AcademyHMEntit").Item(1).Range.Text = arrData(34)

      Else

        ActiveDocument.SelectContentControlsByTag("AM").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("CSA").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("Contract").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("Renewal").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTitle("CurrentHR").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("RUG").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("eRMI").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("PurchasedHRSCBS").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("PurchasedMODAMEJpeRMALOD").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("ActualHRSCBS").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("ActualMODAM").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("ActualER").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("ActualEJp").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("ActualMedApp").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("ActualLoD").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("ERattainmentCons").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("ERattainmentnon-Cons").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("ERattainmentNwBN").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("ERattainmentWBN").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("ERattainmentAHPs").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("ERattainmentPharm").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("eJPAttainmentCons").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("eJPAttainmentNonCons").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("eJPAttainmentNWBN").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("eJPAttainmentAHPs").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("eJPAttainmentPharma").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("AcademyHRPropSent").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("AcademyHmPropSent").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("AcademyHRPropReturned").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("AcademyHMPropReturned").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("AcademyHRcourses").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("AcademyHMcourses").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("AcademyHMEntit").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTag("AcademyHREntit").Item(1).Range.Text = vbNullString


      End If
    Case Else
  End Select
lbl_Exit:
  Exit Sub
End Sub
Sub Document_Open()
Dim strWorkbook As String, strColumnData As String
Dim lngIndex As Long, lngRowIndex As Long, lngColIndex As Long
Dim arrData As Variant
Dim oCC As ContentControl, oFF As FormField, oCtrl As Control
Dim bReprotect As Boolean
  Application.ScreenUpdating = False
  strWorkbook = ThisDocument.Path & "\Excel Data Store.xlsx" 
  If Dir(strWorkbook) = "" Then
    MsgBox "Cannot find the designated workbook: " & strWorkbook, vbExclamation
    Exit Sub
  End If
  arrData = fcnExcelDataToArray(strWorkbook, "Simple List")
  Set oCC = ActiveDocument.SelectContentControlsByTitle("CC Dropdown List").Item(1)
  If oCC.DropdownListEntries.Item(1).Value = vbNullString Then
    For lngIndex = oCC.DropdownListEntries.Count To 2 Step -1
      oCC.DropdownListEntries.Item(lngIndex).Delete
    Next lngIndex
  Else
    oCC.DropdownListEntries.Clear
  End If
  For lngRowIndex = 0 To UBound(arrData, 2)
    oCC.DropdownListEntries.Add arrData(0, lngRowIndex), arrData(0, lngRowIndex)
  Next
  Set oFF = ActiveDocument.FormFields("Formfield_DD_List")
  bReprotect = False
  If ActiveDocument.ProtectionType <> wdNoProtection Then
    ActiveDocument.Unprotect
    bReprotect = True
  End If
  oFF.DropDown.ListEntries.Clear
  For lngRowIndex = 0 To UBound(arrData, 2)
    oFF.DropDown.ListEntries.Add arrData(0, lngRowIndex)
  Next
  If bReprotect Then ActiveDocument.Protect wdAllowOnlyFormFields, True
  With ActiveX_ComboBox
    .Clear
    .AddItem "        "
    For lngRowIndex = 0 To UBound(arrData, 2)
     .AddItem arrData(0, lngRowIndex)
    Next
    .MatchRequired = True
    .Style = fmStyleDropDownList
  End With

  arrData = fcnExcelDataToArray(strWorkbook, "Simple Conditional List")
  Set oCC = ActiveDocument.SelectContentControlsByTitle("CC Conditional Dropdown List").Item(1)

  If oCC.DropdownListEntries.Item(1).Value = vbNullString Then

    For lngIndex = oCC.DropdownListEntries.Count To 2 Step -1
      oCC.DropdownListEntries.Item(lngIndex).Delete
    Next lngIndex
  Else

    oCC.DropdownListEntries.Clear
  End If
  For lngIndex = 0 To UBound(arrData, 2)
    oCC.DropdownListEntries.Add arrData(0, lngIndex), arrData(1, lngIndex)
  Next
  arrData = fcnExcelDataToArray(strWorkbook, "Advanced Conditional List")
  Set oCC = ActiveDocument.SelectContentControlsByTitle("Name").Item(1)
  If oCC.DropdownListEntries.Item(1).Value = vbNullString Then
    For lngIndex = oCC.DropdownListEntries.Count To 2 Step -1
      oCC.DropdownListEntries.Item(lngIndex).Delete
    Next lngIndex
  Else
    oCC.DropdownListEntries.Clear
  End If
  For lngRowIndex = 0 To UBound(arrData, 2)

    strColumnData = vbNullString
    For lngColIndex = 1 To UBound(arrData, 1)
      strColumnData = strColumnData & "|" & arrData(lngColIndex, lngRowIndex)
    Next lngColIndex
    strColumnData = Right(strColumnData, Len(strColumnData) - 1)
    oCC.DropdownListEntries.Add arrData(0, lngRowIndex), strColumnData
  Next
lbl_Exit:
  Application.ScreenUpdating = True
  Exit Sub
End Sub
Private Function fcnExcelDataToArray(strWorkbook As String, _
                                     Optional strRange As String = "Sheet1", _
                                     Optional bIsSheet As Boolean = True, _
                                     Optional bHeaderRow As Boolean = True) As Variant

Dim oRS As Object, oConn As Object
Dim lngRows As Long
Dim strHeaderYES_NO As String
  strHeaderYES_NO = "YES"
  If Not bHeaderRow Then strHeaderYES_NO = "NO"
  If bIsSheet Then strRange = strRange & "$]" Else strRange = strRange & "]"
  Set oConn = CreateObject("ADODB.Connection")
  oConn.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & strWorkbook & ";" & _
        "Extended Properties=""Excel 12.0 Xml;HDR=" & strHeaderYES_NO & """;"
  Set oRS = CreateObject("ADODB.Recordset")
  oRS.Open "SELECT * FROM [" & strRange, oConn, 2, 1
  With oRS
    .MoveLast
    lngRows = .RecordCount
    .MoveFirst
  End With
  fcnExcelDataToArray = oRS.GetRows(lngRows)
lbl_Exit:
  If oRS.State = 1 Then oRS.Close
  Set oRS = Nothing
  If oConn.State = 1 Then oConn.Close
  Set oConn = Nothing
  Exit Function
End Function

我希望从 Excel 文档中提取依赖于从下拉列表中选择的客户的数据并填写到 Word 文档中。

在将列添加到主 Excel 表后，我在“ActiveDocument.SelectContentControlsByTag("AcademyHMEntit").Item(1).Range.Text = arrData(34) 行上收到错误代码Run-time error '9': Subscript out of range，因此请相信 VBA 正在尝试使用主 Excel 工作表的过时版本。

以下内容控件的屏幕截图，其中客户名称为下拉列表，黄色位为依赖于它的内容

在此处输入图像描述

标签： excelvbams-word

解决方案

推荐阅读