Question

我正在使用excel 2010.我想看看是否可以从其他2个工作表创建新的临时工作表，并将数据邮件合并到现有的word文档中。然后删除或保存临时工作表并将其重新用作新的临时工作表。所有这些都是以vba形式出现的。感谢。

Answer 1

下面的内容应该让您入门，它会将您使用过的数据加载到单词邮件合并中。您将需要创建一个word文档并保存它 - 然后使用下面的位置。

Dim wd As Object
Dim WDoc As Object
Dim strWorkbookName As String

On Error Resume Next
Set wd = CreateObject("Word.Application")
wd.Application.Visible = True

Set WDoc = wd.Documents.Open("word location") 'change accordingly

strWorkbookName = Application.ActiveWorkbook.FullName

WDoc.MailMerge.OpenDataSource _
    Name:=strWorkbookName, _
   ConfirmConversions:=False, _
ReadOnly:=False, _
LinkToSource:=True, _
AddToRecentFiles:=False, _
Revert:=False, _
Format:=0, _
Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
SQLStatement:="SELECT * FROM `Sheet1$`" 'change to whatever sheet you are using
End If

Answer 2

原谅我迟到的回复。下面的代码从所有现有工作表创建一个新工作表（主），假设它们具有相同的标题，然后使用它作为邮件合并的源，删除工作表将摆脱源，所以你不能做不幸的是，至少我不知道你可以......

 Dim wrk As Workbook 'Workbook object - Always good to work with object variables
Dim sht As Worksheet 'Object for handling worksheets in loop
Dim trg As Worksheet 'Master Worksheet
Dim rng As Range 'Range object
Dim colCount As Integer 'Column count in tables in the worksheets
Dim wd As Object 'used for word document
Dim WDoc As Object
Dim strWorkbookName As String
Set wrk = ActiveWorkbook 'Working in active workbook

For Each sht In wrk.Worksheets
    If sht.Name = "Master" Then
        MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _
        "Please remove or rename this worksheet since 'Master' would be" & _
        "the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error"
        Exit Sub
    End If
Next sht




 'Add new worksheet as the last worksheet
Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
 'Rename the new worksheet
trg.Name = "Master"
 'Get column headers from the first worksheet
 'Column count first
Set sht = wrk.Worksheets(1)
colCount = sht.Cells(1, 255).End(xlToLeft).Column
 'Now retrieve headers, no copy&paste needed
With trg.Cells(1, 1).Resize(1, colCount)
    .Value = sht.Cells(1, 1).Resize(1, colCount).Value
     'Set font as bold
    .Font.Bold = True
End With

 'We can start loop
For Each sht In wrk.Worksheets
     'If worksheet in loop is the last one, stop execution (it is Master worksheet)
    If sht.Index = wrk.Worksheets.Count Then
        Exit For
    End If
     'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
    Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
     'Put data into the Master worksheet
    trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
Next sht
 'Fit the columns in Master worksheet
trg.Columns.AutoFit


On Error Resume Next
Set wd = CreateObject("Word.Application") 'creates document
wd.Application.Visible = True 'make word document visible

Set WDoc = wd.Documents.Open("word document location") 'change accordingly

strWorkbookName = Application.ActiveWorkbook.FullName 'declares this workbook as the active workbook to use

WDoc.MailMerge.OpenDataSource _
Name:=strWorkbookName, _
ConfirmConversions:=False, _
ReadOnly:=False, _
LinkToSource:=True, _
AddToRecentFiles:=False, _
Revert:=False, _
Format:=0, _
Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
SQLStatement:="SELECT * FROM `Master$`" 'uses temporary created sheet as data source

用于创建临时工作表的vba代码，并将数据邮件合并到word，然后删除临时工作表

2 个答案: