急！在线等！如何将word模板里面文本框内的数据也替换掉

zheng3yu

插入图片到Word模版.rar (24.17 KB, 下载次数: 99)

2013-3-5 22:27 上传

点击文件名下载附件

JING夫

不明白你的需求，能否说清楚一些

zheng3yu

JING夫 发表于 2013-3-5 23:11
不明白你的需求，能否说清楚一些

比如word模板  内的数据001       文本框内的数据001 是替换不掉的。。。其他地方可以替换掉

sqhsqhli

改你的代码：

Private Sub CommandButton输出通知到Word文件_Click()
    Dim Word对象 As Word.Application, 当前路径, 导出文件名, 导出路径文件名, i, j
    Dim Str1, Str2, image1
    Dim myDoc As Word.Document
    Dim sp As Word.Shape
    Dim num As Integer
    Dim filename As String
    num = 1
    当前路径 = ThisWorkbook.Path
    最后行号 = Sheets("数据").Range("B65536").End(xlUp).Row
    判断 = 0
    Set Word对象 = CreateObject("Word.Application")
    For i = 2 To 最后行号
        导出文件名 = "授课通知"
        filename = 当前路径 & "\" & 导出文件名 & "(" & Sheets("数据").Range("B" & i) & ").doc"
        If Dir("filename") <> "" Then Kill filename
        Set myDoc = Word对象.Documents.Add(Template:=当前路径 & "\授课通知(模板).doc")
        With myDoc
            '也可自行将num改为excel指定的值
            .Shapes(1).TextFrame.TextRange.Find.Execute findtext:="001", replacewith:="第" & num & "号", Replace:=wdReplaceOne
            num = num + 1

            .Select
            With .Application.Selection
                For j = 1 To 5    '填写文字数据
                    Str1 = "数据" & Format(j, "000")
                    Str2 = Sheets("数据").Cells(i, j + 1)
                    .HomeKey Unit:=wdStory    '光标置于文件首
                    If .Find.Execute(Str1) Then  '查找到指定字符串
                        .Font.Color = wdColorAutomatic    '字符为自动颜色
                        .Text = Str2    '替换字符串
                    End If
                Next j

                Str1 = Sheets("图片数据").Cells(2, 1)
                Str2 = ""
                .HomeKey Unit:=wdStory    '光标置于文件首
                If .Find.Execute(Str1) Then  '查找到指定字符串
                    .Font.Color = wdColorAutomatic    '字符为自动颜色
                    .Text = Str2    '替换字符串
                End If
                image1 = Sheets("图片数据").Cells(2, 2)
                .InlineShapes.AddPicture filename:=当前路径 & "\" & image1    ' & ", LinkToFile:=False", SaveWithDocument:=True


                For j = 1 To 3    '填写表格数据
                    myDoc.Tables(1).Cell(2, j).Range = Sheets("数据").Cells(i, j + 6)
                    myDoc.Tables(1).Cell(4, j).Range = Sheets("数据").Cells(i, j + 9)
                Next j
                .Application.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader    '设置位置在页眉
                Str1 = "数据006"
                Str2 = Sheets("数据2").Cells(2, 2)
                .HomeKey Unit:=wdStory    '光标置于文件首
                If .Find.Execute(Str1) Then  '查找到指定字符串
                    .Font.Color = wdColorAutomatic    '字符为自动颜色
                    .Text = Str2    '替换字符串
                End If
                .Application.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter    '设置位置在页脚
                Str1 = "数据007"
                Str2 = Sheets("数据2").Cells(2, 1)
                .HomeKey Unit:=wdStory    '光标置于文件首
                If .Find.Execute(Str1) Then  '查找到指定字符串
                    .Font.Color = wdColorAutomatic    '字符为自动颜色
                    .Text = Str2    '替换字符串
                End If
            End With
            .SaveAs filename:=当前路径 & "\" & 导出文件名 & "(" & Sheets("数据").Range("B" & i) & ").doc"
            .Close savechanges:=wdSaveChanges
            Set myDoc = Nothing
        End With
    Next i
    Word对象.Quit
    Set Word对象 = Nothing
    If 判断 = 0 Then
        i = MsgBox("已输出到 Word 文件！", 0 + 48 + 256 + 0, "提示：")
    End If
End Sub

zheng3yu

sqhsqhli 发表于 2013-3-7 10:05
改你的代码：

Private Sub CommandButton输出通知到Word文件_Click()

非常感谢！