邮件合并功能中的多记录问题

weg

很不理解，为什么word不增加这两个域：forward， forward if

如果有这两个域，这道题就可以完美解决了。

weg

有一个办法，可以解决问题，但有条件如下，不知道suyuanning能否接受：

估计一下日常工作中，最多有多少个保管位置，假如500个，那么就要创建一个包含500个一模一样表格的主文档，源数据不必修改。一次创建，可以永久使用，只要少于500的都行。

守柔

QUOTE:

以下是引用suyuanning在2006-9-21 19:24:59的发言：

搜索了论坛所有关于“邮件合并”的帖子，有一个和我的要求差不多，但是最后还是没有人给出解决办法。守柔版主，给个思路。

C81，单个表在EXCEL里是可以实现的，我现在考虑在EXCEL用一辅助列存放不重复的保管位置，然后用VBA根据辅助列的内容来生成多个表格，但是在EXCEL分页很麻烦。

fSLjYjxM.rar (13.4 KB, 下载次数: 14)

2006-9-22 06:42 上传

点击文件名下载附件
邮件合并功能中的多记录问题

请先对C列排序，如果需要修改WORD 模板中的表格格式，请在文档中键入“我的表格”后回车，修改表格，并且在插入/自动图文集（模板位置：保管位置.dot）重新定义这个自动图文集即可。

以下代码供参考：

Option Explicit

Sub WritetoWord()

'请引用Microsoft Word 11.0 Object Library(视版本情况）
    Dim wdApp As New Word.Application, wdDoc As Word.Document, wdRange As Word.Range
    Dim wdTable As Word.Table, RowId As Integer
    Dim xlRange As Range, i As Range, EndCell As Range
    With Sheets(1)
        Set EndCell = .[C65536].End(xlUp)
        Set xlRange = .Range(.Range("C2"), EndCell)
    End With
    Set wdDoc = wdApp.Documents.Open(Filename:=ThisWorkbook.Path & "\保管位置.dot")
    With wdDoc
        Set wdTable = .Tables(1)
        For Each i In xlRange
            RowId = RowId + 1
            If i.Offset(1, 0).Value = i.Value Then
                With wdTable
                    .Cell(1, 1).Range.Text = "保管位置：" & i.Value
                    .Cell(RowId + 2, 1).Range.Text = i.Offset(, -2).Value
                    .Cell(RowId + 2, 2).Range.Text = i.Offset(, -1).Value
                End With
            Else
                With wdTable
                    .Cell(1, 1).Range.Text = "保管位置：" & i.Value
                    .Cell(RowId + 2, 1).Range.Text = i.Offset(, -2).Value
                    .Cell(RowId + 2, 2).Range.Text = i.Offset(, -1).Value
                End With
                If i.Address <> EndCell.Address Then
                    .Content.InsertAfter Chr(12)
                    Set wdRange = .Range(.Content.End - 1, .Content.End - 1)
                    .AttachedTemplate.AutoTextEntries("我的表格").Insert wdRange
                    Set wdTable = .Tables(.Tables.Count)
                    RowId = 0
                End If
            End If
        Next
    End With
    wdApp.Visible = True
    Set wdApp = Nothing
End Sub
有关更多内容，请以“AttachedTemplate.AutoTextEntries”关键字搜索本版。

[此贴子已经被作者于2006-9-22 6:45:48编辑过]

suyuanning

谢谢守柔版主！解决了我的一大问题，现在在慢慢的学习消化你的那段代码

suyuanning

Set wdDoc = wdApp.Documents.Open(Filename:=ThisWorkbook.Path & "\保管位置.dot")

版主,这句话我理解为打开"保管位置.dot"这个模板并赋值给wdDoc,如果我想利用这个模板来生成一个文件,语句该怎么写?另,我右键打开这个模板,修改其中的表格格式以后,在自动图文集里更新了,但是在通过EXCEL生成的WORD文档里面,自动图文集生成的表格的格式还是原来的样子,这是什么原因?

[此贴子已经被作者于2006-9-25 11:13:12编辑过]

suyuanning

请大家帮忙看看我的代码,为什么生成的WORD文档中,利用自动图文集生成的表格和模板的不一样的?高度不一样,还有段落、字体等都不一样。我修改了你的代码，把插入“下一页”换成了“回车”，这样做的目的是可以利用分栏在一页里打多个标签。 gGMS98V0.rar (36.75 KB, 下载次数: 8)

2006-9-25 17:20 上传

点击文件名下载附件
邮件合并功能中的多记录问题

Sub WritetoWord()
    Dim wdApp As New Word.Application, wdDoc As Word.Document, wdRange As Word.Range
    Dim wdTable As Word.Table, RowId As Integer
    Dim xlRange As Range, i As Range, EndCell As Range
    With Sheets("2001年后科技档案（含本港北部湾123及飞跃168历年档案）")
        Set EndCell = .[H65536].End(xlUp) '找到H列最后一个有数据单元格
        Set xlRange = .Range(.Range("H2"), EndCell) '定义H列数据范围
    End With
    Set wdDoc = wdApp.Documents.Open(Filename:=ThisWorkbook.Path & "\保管位置.dot") '打开模板
    With wdDoc
        Set wdTable = .Tables(1) 'WORD第一个表格
        For Each i In xlRange '遍历H列数据范围
            RowId = RowId + 1 '下移一个单元格
            If i.Offset(1, 0).Value = i.Value Then '如果下一个单元格的值与当前单元格值相同
                With wdTable
                    .Cell(1, 1).Range.Text = "保管位置：" & i.Value '把当前单元格的数值填入表格的第一个单元格
                   ' .Cell(RowId + 1, 1).Range.Text = i.Offset(, -2).Value '取相应的数值填入WORD表格的单元格
                    .Cell(RowId + 3, 1).Range.Text = i.Offset(, 3).Value '取相应的数值填入WORD表格的单元格
                    .Cell(RowId + 3, 2).Range.Text = i.Offset(, 2).Value '取相应的数值填入WORD表格的单元格
                End With
            Else
                With wdTable
                    .Cell(1, 1).Range.Text = "保管位置：" & i.Value
                    '.Cell(RowId + 2, 1).Range.Text = i.Offset(, -2).Value
                    .Cell(RowId + 3, 1).Range.Text = i.Offset(, 3).Value
                    .Cell(RowId + 3, 2).Range.Text = i.Offset(, 2).Value 
                End With
                If i.Address <> EndCell.Address Then '如果没有遍历到最后一个数据
                    .Content.InsertAfter Chr(13) '插入回车符
                    Set wdRange = .Range(.Content.End - 1, .Content.End - 1)'此句不明白
                    .AttachedTemplate.AutoTextEntries("我的表格").Insert wdRange '插入自动图文集生成表格
                     Set wdTable = .Tables(.Tables.Count) '定义wdTable为当前操作的表格
                    RowId = 0
                End If
            End If
        Next
    End With
    wdApp.Visible = True
    Set wdApp = Nothing
End Sub

[此贴子已经被作者于2006-9-25 18:53:05编辑过]

suyuanning

继续求助！

守柔

'我修改的几句代码,供参考.

Sub WritetoWord()
    Dim wdApp As New Word.Application, wdDoc As Word.Document, wdRange As Word.Range
    Dim wdTable As Word.Table, RowId As Integer
    Dim xlRange As Range, i As Range, EndCell As Range
    With Sheets("2001年后科技档案（含本港北部湾123及飞跃168历年档案）")
        Set EndCell = .[H65536].End(xlUp) '找到H列最后一个有数据单元格
        Set xlRange = .Range(.Range("H2"), EndCell) '定义C列数据范围
    End With
   ' Set wdDoc = wdApp.Documents.Open(Filename:=ThisWorkbook.Path & "\保管位置.dot", Format:=wdOpenFormatDocument) '根据模板创建空白WORD文档
    Set wdDoc = wdApp.Documents.Add(Template:=ThisWorkbook.Path & "\保管位置.dot", NewTemplate:=False)
    With wdDoc
        Set wdTable = .Tables(1) 'WORD第一个表格
        For Each i In xlRange '遍历C列数据范围
            RowId = RowId + 1 '下移一个单元格
            If i.Offset(1, 0).Value = i.Value Then '如果下一个单元格的值与当前单元格值相同
                With wdTable
                    .Cell(1, 1).Range.Text = "保管位置：" & i.Value '把当前单元格的数值填入表格的第一个单元格
                   ' .Cell(RowId + 1, 1).Range.Text = i.Offset(, -2).Value '取相应的数值填入WORD表格
                    .Cell(RowId + 3, 1).Range.Text = i.Offset(, 3).Value '取相应的数值填入WORD表格
                    .Cell(RowId + 3, 2).Range.Text = i.Offset(, 2).Value '取相应的数值填入WORD表格
                End With
            Else
                With wdTable
                    .Cell(1, 1).Range.Text = "保管位置：" & i.Value
                    '.Cell(RowId + 2, 1).Range.Text = i.Offset(, -2).Value
                    .Cell(RowId + 3, 1).Range.Text = i.Offset(, 3).Value
                    .Cell(RowId + 3, 2).Range.Text = i.Offset(, 2).Value '取相应的数值填入WORD表格
                End With
                If i.Address <> EndCell.Address Then '如果没有遍历到最后一个数据
                    .Content.InsertAfter Chr(13) '插入分节符
                    Set wdRange = .Range(.Content.End - 1, .Content.End - 1)
                    .AttachedTemplate.AutoTextEntries("我的表格").Insert wdRange, True '插入带有格式自动图文集生成表格
                                   
                    Set wdTable = .Tables(.Tables.Count) '定义wdTable为当前操作的表格
                    RowId = 0
                End If
            End If
        Next
        .SaveAs Filename:="F:\A.doc" '将文档另存为指定路径下的文件
    End With
    wdApp.Visible = True
    Set wdApp = Nothing
End Sub

suyuanning

谢谢！终于搞好了！