Question

[求助] ：excel vba替换word文档的内容问题！谢谢！

求解：excel vba替换word文档的内容问题！在做excel的内容替换到word里面时，有过程但未成功（如果新建一个excel使用该代码就可以完成），求解是什么问题怎么解决？截图代码：Sub test1()iweizhi = 14'生成合同文件Dim yangbenpath As Stringyangbenpath = Application.ActiveWorkbook.Path & Sheets("明细").Cells(iweizhi, 23).Value '获取修改文件《测试.doc》的位置Dim deskpath As StringDim weizhi As VariantDim WdApp, WdApplication.ScreenUpdating = FalseSet WdApp = CreateObject("word.application")Set Wd = WdApp.Documents.Open(yangbenpath) '打开文件《测试.doc》WdApp.Visible = True WdApp.Selection.Find.ClearFormatting 'weizhi = Split(Sheets("明细").Cells(iweizhi, 24).Value, ",") '以,号分隔的数据赋值 Dim i As Long 'For i = 0 To UBound(weizhi) For i = 23 To 32 Step 1 '替换cells(23,23)到cells（32，24）里面对应的内容 WdApp.Selection.Find.Replacement.ClearFormatting With WdApp.Selection.Find .ClearFormatting .Text = Sheets("明细").Cells(i, 23).Value .Replacement.ClearFormatting .Replacement.Text = Sheets("明细").Cells(i, 24).Value .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue End With Next ideskpath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" '获取桌面位置路径Wd.SaveAs deskpath & Sheets("明细").Cells(3, 24).Value & ".doc" '另存到桌面，文件名称为合同名WdApp.Visible = TrueSet Wd = NothingSet WdApp = NothingApplication.ScreenUpdating = TrueEnd Sub
文档附件链接：//pan.baidu.com/s/19V7-PPLoxkpgHyRwv_Dcug（前面加https:打开）





Answer 1

这个代码，这么贴出来，可读性太差了吧？

不能替换的原因：

excel中的内容和word文档中的内容不能匹配；

excel中的字符串含有很多空格，而WORd中没有，多以find不到，因此不能做Replace。

检查下文档就好了。

另外，代码我也帖一个吧。

Sub test1()
    iweizhi = 14
    '生成合同文件
    Dim yangbenpath As String
    yangbenpath = Application.ActiveWorkbook.Path & Sheets("明细").Cells(iweizhi, 23).Value    '获取修改文件《测试.doc》的位置
    Dim deskpath As String
    Dim weizhi As Variant
    Dim WdApp, Wd, i%, Rng
    Rng = Sheets("明细").Range("W23:X32")
    Application.ScreenUpdating = False
    Set WdApp = CreateObject("word.application")
     WdApp.Visible = True
    With WdApp.Documents.Open(yangbenpath)
        WdApp.Visible = True
        With .Content
            For i = 1 To UBound(Rng)
                If .Find.Execute(Rng(i, 1)) Then
                    .Text = Rng(i, 2)
                End If
            Next i
        End With
        .SaveAs "C:\2.doc"
    End With
'    deskpath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"    '获取桌面位置路径
'    Wd.SaveAs deskpath & Sheets("明细").Cells(3, 24).Value & ".doc"    '另存到桌面，文件名称为合同名
    WdApp.Visible = True
    Set Wd = Nothing
    Set WdApp = Nothing
    Application.ScreenUpdating = True
End Sub