word从excel中获取数据

'如 word开发工具不显示，文件 选项 自定义功能区 开发工具对钩选中
'Dim 字典
Dim SubArray(2, 200) As String
Dim Row As Integer
Dim IsLoaded As Boolean

Private Sub Document_ContentControlOnEnter(ByVal ContentControl As ContentControl)
ContentControl.Range.Select
End Sub

Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
   'MsgBox ContentControl.Type
   'MsgBox ContentControl.Range.Text

   If Not IsLoaded Then
       LoadArray123

       IsLoaded = True
   End If

   For i = 0 To Row Step 1
      If SubArray(0, i) = ContentControl.Range.Text Then
          ContentControl.Range.Text = SubArray(1, i)
          Exit For
      End If
   Next
End Sub

Private Sub Document_New()

End Sub

Private Sub Document_Open()
    IsLoaded = False
End Sub

Private Sub LoadArray123()
    'Set 字典 = CreateObject("Scripting.Dictionary")
    'MsgBox ThisDocument.Path

    Set 连接 = CreateObject("Excel.Application")

    'C:\Users\Administrator\Desktop\test\bbb.xlsx
    Set 表格 = 连接.workbooks.Open(ThisDocument.Path + "\bbb.xlsx")

    连接.Visible = False

    i = 2

    Row = 表格.Worksheets("Sheet1").UsedRange.Rows.Count
    'MsgBox "excel表共有行数" & Row
    'ReDim Preserve SubArray(2, Row)

    For i = 2 To Row Step 1

        SubArray(0, i - 1) = 表格.Worksheets("Sheet1").Range("A" & i).Value
        SubArray(1, i - 1) = 表格.Worksheets("Sheet1").Range("B" & i).Value

        'SubArray(0, i - 1) = "1.1"
        'SubArray(1, i - 1) = "aaaaaaaaaaaa"

    Next

    Set 连接 = Nothing
    Set 表格 = Nothing

End Sub

Private Sub Document_Close()

End Sub