如何在Excel VBA 中读写word文档 步骤

Posted 2023-05-12

1.　库的配置
在默认情况下，新创建的excel vba中不支持定义word对象。
所以需要先引入word库，操作步骤如下：
1.1 打开excel vba 界面
1.2 选中其中的一个Module
1.3 选择菜单， Tools --> References
在打开的对话框中选择类似 "Microsoft Word 14.0 Object Library".
1.4 点击OK保存配置。
2. 打开文档
Set wordApplication = CreateObject("Word.Application")
wordApplication.Visible = False
Dim hasOpenDoc As Boolean
hasOpenDoc = IsOpen(filePath) ' is a self-defined function to check file is opend
If hasOpenDoc = True then
Set wordDoc = GetObject(filePath)
End if
If hasOpenDoc = False Then
Set wordDoc = wordApplication.Documents.Open(filePath)
End if
wordDoc.Active
With wordApplication
Dim aParagraph As Word.Paragraph
For Each aParagraph In wordDoc.Paragraphs
' do some thing to every paragraph.
Next aParagraph
End with
wordDoc.Close
Set wordDoc = nothing
' 如下这段代码引用某位牛人的，非常感谢他。由于路径丢失，不能给出链接, 抱歉
' 如下的找寻方式，能够正确的找出文件是否被打开
Function IsOpen(fileName As String) As Boolean
IsOpen = False
Dim findFile As Integer
findFile = FreeFile()
On Error GoTo ErrOpen
Open fileName For Binary Lock Read Write As findFile
Close findFile
Exit Function
ErrOpen:
If Err.Number <> 70 Then
Msg = "Error # " & Str(Err.Number) & "was generated by " & Err.Source & Chr(13) & Err.Description
MsgBox Msg, "Error", Err.HelpFile, Err.HelpContext
Else
IsOpen = True
End If
End Function 参考技术A 参考这个:
Sub ExcelToWord() ' 利用Word程序创建文本文件
Dim WordApp As Object
Dim Records As Integer, i As Integer
Dim Region As String, SalesAmt As String, SalesNum As String, strTitle As String

Set WordApp = CreateObject("Word.Application") '创建word对象
Records = Application.CountA(Sheets("sheet1").Range("A:A")) 'A列数据个数

WordApp.Documents.Add '新建文档

'写Title
strTitle = Cells(1, 5)
With WordApp.Selection
.Font.Size = 28
.ParagraphFormat.Alignment = 1 '左对齐0 居中1 右对齐2
.Font.Bold = True
.TypeText Text:=strTitle
.TypeParagraph
End With

'写内容
For i = 1 To Records
'Region = Data.Cells(i, 1).Value '将第一列某行的值赋值给变量
Region = Cells(i, 1)
'SalesNum = Data.Cells(i, 2).Value '获取该行B列数据
SalesNum = Cells(i, 2)
'SalesAmt = Data.Cells(i, 3).Value '获取该行C列数据
SalesAmt = Cells(i, 3)

With WordApp.Selection

.Font.Size = 14 '设置字体字号
.Font.Bold = True '字体粗
.ParagraphFormat.Alignment = 0 '设置对齐
.TypeText Text:=Region & SalesNum
.TypeParagraph

.Font.Size = 12 '设置字体
.ParagraphFormat.Alignment = 0 '设置对齐
.Font.Bold = False '字体不加粗
.TypeText Text:=vbTab & SalesAmt
.TypeParagraph '回车
.TypeParagraph '回车

End With
Next i

WordApp.ActiveDocument.SaveAs Filename:="AAA" '保存文件
WordApp.Quit '退出程序
Set WordApp = Nothing '清空
MsgBox "文件保存在<a href="https://www.baidu.com/s?wd=%E6%88%91%E7%9A%84%E6%96%87%E6%A1%A3&tn=44039180_cpr&fenlei=mv6quAkxTZn0IZRqIHckPjm4nH00T1Y3ny7WmhFhnHu-njcLnjDL0ZwV5Hcvrjm3rH6sPfKWUMw85HfYnjn4nH6sgvPsT6KdThsqpZwYTjCEQLGCpyw9Uz4Bmy-bIi4WUvYETgN-TLwGUv3EnHRLPHDknHmznWT4rjbkrH6zn0" target="_blank" class="baidu-highlight">我的文档</a>底下的AAA文件"

End Sub

基于Excel中数据库的VBA在word中查找和替换

【中文标题】基于Excel中数据库的VBA在word中查找和替换

【英文标题】：VBA Find and Replace in word based on Database in Excel

【发布时间】：2014-02-26 21:52:47

【问题描述】：

我正在寻找一种基于 Excel 中的数据在 Word 文档中查找和替换文本的方法

更具体地说：

A 列 = 我要查找的文本 B 列 = 文本我想将找到的文本替换为

我已经知道 VBA 中的基本查找和替换代码，但我正在努力弄清楚如何做到这一点（跨应用程序）。

谁能帮帮我？

谢谢:)

请求的屏幕截图：

由于显示了潜在的敏感信息，我截取了我的电子表格示例，但这给出了要点。

【参考方案1】：

以下代码需要引用MS Word 14.0 Object Library 或您的任何等效项。如果您不想要早期绑定，则由您决定将其转换为后期绑定。

Sub FindReplaceInWord()

    Dim Wbk As Workbook: Set Wbk = ThisWorkbook
    Dim Wrd As New Word.Application
    Dim Dict As Object
    Dim RefList As Range, RefElem As Range

    Wrd.Visible = True
    Dim WDoc As Document
    Set WDoc = Wrd.Documents.Open("C:\xxx\Doc1.docx") 'Modify as necessary.

    Set Dict = CreateObject("Scripting.Dictionary")
    Set RefList = Wbk.Sheets("Sheet1").Range("A1:A3") 'Modify as necessary.

    With Dict
        For Each RefElem In RefList
            If Not .Exists(RefElem) And Not IsEmpty(RefElem) Then
                .Add RefElem.Value, RefElem.Offset(0, 1).Value
            End If
        Next RefElem
    End With

    For Each Key In Dict
        With WDoc.Content.Find
            .Execute FindText:=Key, ReplaceWith:=Dict(Key)
        End With
    Next Key

    'Enable the following three if you want.
    'WDoc.Save
    'WDoc.Close
    'Wrd.Quit

End Sub

截图：

Word Document (before running code)

Reference List in Excel

Word Document (after running code)

如果这有帮助，请告诉我们。

编辑：

作为参考，代码与您的列表没有问题。我认为这完全是另一回事。看我的截图。

如您所见，使用Debug.Print Key, Dict(Key) 表明它是安全的。我已经修改了上面的代码以更改可能导致此问题的某些内容。 :)

【讨论】：

哇@BK201 谢谢。这与我正在寻找的非常接近！唯一的挫折是这段代码无法处理重复项（我使用的索引将用相同的文本替换一些不同的单词）和Run-Time error '457': This Key is already associated with an element of this collection. 的错误有什么办法吗？我现在在那里弹出了一个“On Error Resume Next”，但这不会注册所需的字典条目。

如果我理解正确的话，列表的左边是要替换的词，右边是替换词，是吗？这基本上意味着您不应该在左侧有重复项，否则它将被替换两次。左侧应该是唯一的，但右侧可以有重复项。或者我在这里错过了什么？你能张贴你的参考列表的截图吗？

上面添加的屏幕截图... A 列完全是唯一的，但 B 列包含一些重复项，其中数据被压缩到 word 文档中。我逐步浏览了显示 MsgBox 的代码，它在哪里为字典捕获数据，据我所知，当在引用的“B 列”中遇到重复项时会发生错误

我想我知道为什么。 :) 您是否偶然提到了整个 A 列？因为如果是这样，它必须将空白单元格也视为键。最好是真正明确并使用适当的“结束”单元格分配范围。此外，将上面的代码更改为检查If Not IsEmpty 而不是Is Not Nothing。这一区别至关重要。这次使用上面修改过的代码再次运行它。 :)

那好多了，谢谢/ 不过还有一个小问题。当我运行它时，我的所有字段都被删除而不会被新文本替换 - 有点。我浏览了它（花了一段时间），我看到文本首先被我的工作表中的数据成功替换并且看起来很好，但是在.Execute FindText:=Key, ReplaceWith:=Dict(Key) 的下一个循环中它再次消失并留空。你能想出一个原因吗？我认为我的范围还可以 - 设置为 .Range("A1:B236")