Word VBA
Excel VBA
操作word
' 声明 Word 应用程序对象
Dim wordApp As Object' 初始化 Word 应用程序
Sub InitializeWordApp()On Error Resume NextSet wordApp = CreateObject("Word.Application")wordApp.Visible = False ' 设置 Word 不可见，避免干扰
End Sub' 关闭 Word 应用程序
Sub CloseWordApp()On Error Resume NextwordApp.QuitSet wordApp = Nothing
End Sub' 获取或打开 Word 文档
Function GetOrOpenWordDocument(filePath As String) As ObjectOn Error Resume NextDim doc As Object' 如果 Word 应用程序未初始化，则初始化If wordApp Is Nothing ThenCall InitializeWordAppEnd If' 如果文件路径不为空，则尝试打开文档If filePath <> "" Then' 检查文档是否已经打开On Error Resume NextSet doc = wordApp.Documents(filePath)On Error GoTo 0' 如果文档未打开，则尝试打开If doc Is Nothing ThenSet doc = wordApp.Documents.Open(filePath)End IfElse' 如果文件路径为空，则创建一个新文档Set doc = wordApp.Documents.AddEnd IfSet GetOrOpenWordDocument = doc
End Function' 查找文本
Function FindTextInWord(doc As Object, searchText As String) As BooleanOn Error Resume NextFindTextInWord = doc.Content.Find.Execute(FindWhat:=searchText, MatchCase:=False, MatchWholeWord:=False)
End Function' 写入文本
Sub WriteTextToWord(doc As Object, text As String)On Error Resume Nextdoc.Content.InsertAfter text & vbNewLine
End Sub' 读取表格内容
Function ReadTableFromWord(doc As Object, tableIndex As Integer, row As Integer, column As Integer) As StringOn Error Resume NextIf doc.Tables.Count >= tableIndex ThenReadTableFromWord = doc.Tables(tableIndex).Cell(row, column).Range.Text' 去掉多余的换行符ReadTableFromWord = Trim(Left(ReadTableFromWord, Len(ReadTableFromWord) - 2))ElseReadTableFromWord = ""End If
End Function' 写入表格数据
Sub WriteTableDataToWord(doc As Object, tableIndex As Integer, row As Integer, column As Integer, data As String)On Error Resume NextIf doc.Tables.Count >= tableIndex Thendoc.Tables(tableIndex).Cell(row, column).Range.Text = dataEnd If
End Sub' 设置表格样式
Sub SetTableStyleInWord(doc As Object, tableIndex As Integer, styleName As String)On Error Resume NextIf doc.Tables.Count >= tableIndex Thendoc.Tables(tableIndex).Style = styleNameEnd If
End Sub' 示例：从 Word 文档中提取表格数据到 Excel
Sub ExampleExtractWordTableDataToExcel()Dim filePath As StringDim doc As ObjectDim ws As WorksheetDim tableIndex As IntegerDim rowNumber As IntegerDim cellContent As String' 设置文件路径filePath = "C:\路径\到\你的\文件\a.docx" ' 修改为实际的文件路径' 获取或打开 Word 文档Set doc = GetOrOpenWordDocument(filePath)If doc Is Nothing ThenMsgBox "无法获取或打开 Word 文档！", vbExclamationExit SubEnd If' 设置目标工作表为 Sheet1Set ws = ThisWorkbook.Sheets("Sheet1")rowNumber = 1 ' 初始化行号，从第一行开始写入' 遍历第 7 到第 19 个表格For tableIndex = 7 To 19cellContent = ReadTableFromWord(doc, tableIndex, 1, 2)If cellContent <> "" Thenws.Cells(rowNumber, 1).Value = cellContentrowNumber = rowNumber + 1End IfNext tableIndex' 关闭 Word 文档（如果需要）' doc.Close FalseMsgBox "数据提取完成！", vbInformation
End Sub' 示例：向 Word 文档中写入表格数据
Sub ExampleWriteTableDataToWord()Dim filePath As StringDim doc As ObjectDim ws As WorksheetDim tableIndex As IntegerDim row As IntegerDim column As IntegerDim data As String' 设置文件路径filePath = "C:\路径\到\你的\文件\a.docx" ' 修改为实际的文件路径' 获取或打开 Word 文档Set doc = GetOrOpenWordDocument(filePath)If doc Is Nothing ThenMsgBox "无法获取或打开 Word 文档！", vbExclamationExit SubEnd If' 设置目标工作表为 Sheet1Set ws = ThisWorkbook.Sheets("Sheet1")' 设置表格索引、行、列和数据tableIndex = 1row = 1column = 2data = "新内容"' 写入表格数据Call WriteTableDataToWord(doc, tableIndex, row, column, data)' 保存并关闭 Word 文档doc.Save' doc.Close FalseMsgBox "数据写入完成！", vbInformation
End Sub' 示例：设置 Word 文档中表格样式
Sub ExampleSetTableStyleInWord()Dim filePath As StringDim doc As ObjectDim tableIndex As IntegerDim styleName As String' 设置文件路径filePath = "C:\路径\到\你的\文件\a.docx" ' 修改为实际的文件路径' 获取或打开 Word 文档Set doc = GetOrOpenWordDocument(filePath)If doc Is Nothing ThenMsgBox "无法获取或打开 Word 文档！", vbExclamationExit SubEnd If' 设置表格索引和样式名称tableIndex = 1styleName = "表格式 专业型"' 设置表格样式Call SetTableStyleInWord(doc, tableIndex, styleName)' 保存并关闭 Word 文档doc.Save' doc.Close FalseMsgBox "表格样式设置完成！", vbInformation
End Sub
