Sub printer()
On Error Resume Next
Dim a%
Application.ScreenUpdating = False
' Application.Dialogs(wdDialogFilePrint).Display '顯示列印視窗
a = Application.Dialogs(wdDialogFilePrint).Display
If a = -1 Then '判斷列印視窗點擊的是確定還是取消，-1是確定
Dim oMailMerge As MailMerge '以下重繪資料源
Dim oDoc As Document
Dim oMailMergeDataSource As MailMergeDataSource
Dim sPath As String
Dim sName As String
Dim sConStr As String
sPath = Word.ActiveDocument.Path & "\"
sName = "五班名錄.xlsm"
Set oDoc = Word.ActiveDocument
Set oMailMerge = oDoc.MailMerge
'連接字串
sConStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sPath & sName & ";Extended Properties='HDR=YES;IMEX=1'"
'郵件合并物件
With oMailMerge
.MainDocumentType = wdFormLetters
'Name引數表示excel資料源的完整路徑, LinkToSource引數表示是否每次打開word檔案都執行sql命令,Revert表示如果資料源已經打開是否重新打開
.OpenDataSource Name:=sPath & sName, _
LinkToSource:=False, _
Revert:=True, _
Connection:=sConStr, _
SQLStatement:="SELECT * FROM [sheet1$A1:F50]"
End With
Application.DisplayAlerts = False
With ActiveDocument.MailMerge
.Destination = wdSendToPrinter '列印
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
Application.OnTime Now + TimeValue("0:0:1"), "sendkeystrokes"
SendKeys "%H{LEFT}" '跳轉到自定義選項卡
Application.DisplayAlerts = True
Application.ScreenUpdating = True
' Else
' End
End If
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/172584.html
標籤：VBA