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

 

posted @ 2023-03-29 17:55  古锁阳关  阅读(453)  评论(0编辑  收藏  举报