Excel 用代码 批量生成 Word 文件出错

砂海

Excel 用代码 批量生成 Word 文件出错
( 因数据块大小不定 , 故无法邮件合并. )

求助Excel操作Word.rar (19.61 KB, 下载次数: 10)

2016-6-23 22:15 上传

点击文件名下载附件

砂海

Selection.HomeKey wdStory '把光标移到最开始

这句 如何 修改.?
其它,我可以 类推.

JX_shangrila

Selection.HomeKey wdStory '把光标移到最开始
Selection.HomeKey wdLine   '将光标移到行首
Selection.EndKey wdLine      '将光标移到行末
看你图片是表格数据，可以直接用vba操作表格数据的
ActiveDocument.Tables

砂海

JX_shangrila 发表于 2016-6-24 09:09
Selection.HomeKey wdStory '把光标移到最开始
Selection.HomeKey wdLine   '将光标移到行首
Selection ...

Sub Macro1()

    Dim rng As Range, 客户$
    客户 = ThisWorkbook.Sheets("调整").Range("b2").Value

    Dim MyWord As Object
    Set MyWord = CreateObject("word.application")

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Set rng = [h11].CurrentRegion
    With MyWord
        .Visible = True
        .Documents.Open (ThisWorkbook.Path & "\通知模板.doc")
'''===============================================================
'''以下代码 运行出错
Selection.HomeKey wdStory '把光标移到最开始    '''本句录制于Word , 此处运行出错
Selection.MoveRight Unit:=wdCharacter, Count:=3
Selection.TypeText Text:=客户   ''' 甲 ,此处为文本

        rng.Copy       '复制
        .Selection.PasteExcelTable False, False, False  '''粘贴为表格
        .Selection.WholeStory
        .Selection.Font.Size = 12
        With .Options
            .DefaultBorderLineStyle = wdLineStyleSingle
            .DefaultBorderLineWidth = wdLineWidth050pt
            .DefaultBorderColor = wdColorAutomatic
        End With
        .Selection.Tables(1).PreferredWidthType = 3
        .Selection.Tables(1).PreferredWidth = .CentimetersToPoints(15)

'''===============================================================

        .ActiveDocument.SaveAs Filename:=ThisWorkbook.Path & "\" & 客户 & ".doc"
        .ActiveDocument.Close
        .Quit
    End With
    Set MyWord = Nothing
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "ok"
End Sub

砂海

Selection.HomeKey wdStory '把光标移到最开始    '''本句录制于Word , 此处运行出错
Selection.MoveRight Unit:=wdCharacter, Count:=3
Selection.TypeText Text:=客户   ''' 甲 ,此处为文本

这3句 从Word 移植 过来的. 求修改

JX_shangrila

打开语句和从Word 移植 过来的语句修改如下，表格语句没有看，但同样可以用With ss.Words来解决。
Set ss = .Documents.Open(ThisWorkbook.Path & "\通知模板.doc")
  With ss.Words
         .Item(2).Text = "：" & 客户
         .Item(7).Text = "：" & "大中华地区"
   End With

砂海

JX_shangrila 发表于 2016-6-24 15:14
打开语句和从Word 移植 过来的语句修改如下，表格语句没有看，但同样可以用With ss.Words来解决。
Set s ...

.Item(2)
怎样关联到文档.
例如下图

--------------------------------------------------
网上Item 多是 字典 , 求指点

砂海

Excel 里面 用单元格 地址 .
Word 一时不知道怎么弄.

JX_shangrila

已经解释得蛮清楚了，set  ss=....就是关联doc对象呀。如果.Item()的具体数值不对可根据实际情况调整。
Sub Macro1()

    Dim rng As Range, 客户$
    客户 = ThisWorkbook.Sheets("调整").Range("b2").Value

    Dim MyWord As Object
    Set MyWord = CreateObject("word.application")

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    With MyWord
        .Visible = True
        Set ss = .Documents.Open(ThisWorkbook.Path & "\通知模板.doc")
'''===============================================================
       With ss.Words
            .Item(2).Text = "：" & 客户
            .Item(7).Text = "：" & "大中华地区"
            .Item(45).Text = [h11]
            .Item(47).Text = [i11]
            .Item(50).Text = [j11]
            .Item(54).Text = [h12]
            .Item(56).Text = [i12]
            .Item(58).Text = [j12]
            .Item(61).Text = [h13]
            .Item(63).Text = [i13]
            .Item(65).Text = [j13]
       End With

'''===============================================================

        .ActiveDocument.SaveAs Filename:=ThisWorkbook.Path & "\" & 客户 & ".doc"
        .ActiveDocument.Close
        .Quit
    End With
    Set MyWord = Nothing
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "ok"
End Sub

JX_shangrila

如果用doc表格对象更好，论坛上就简单一点吧。