通过excel打印word文档

时间:2018-06-18 10:30:56

标签: excel-vba printing mailmerge vba excel

我通过使用excel将数据输入MS word文件的vba代码设置邮件合并。我想从excel添加打印选项到连接的打印机。假设有5个字母需要打印我希望当打印一个字母时,第二个字母命令将在5秒后打开。

想直接从excel(而不是从word)打印到打印机,只能打印机,如HP1100等。

任何建议?

这是代码

   Sub CreateWordDocuments()
Dim CustRow, CustCol, LastRow, TemplRow, FrDays, ToDays As Long
Dim DocLoc, TagName, TagValue, TemplName, FileName, PrintStatus As String
Dim CurDt, LastAppDt As Date
Dim WordDoc, WordApp, OutApp, OutMail As Object
Dim WordContent As Word.Range
With Sheet1

  If .Range("B3").Value = Empty Then
    MsgBox "Please select a correct template from the drop down list"
    .Range("g3").Select
    Exit Sub
  End If
    TemplRow = .Range("B3").Value 'Set Template Row
    TemplName = .Range("G3").Value 'Set Template Name
    'FrDays = .Range("L3").Value 'Set From Days
    'ToDays = .Range("N3").Value 'Set To Days
    DocLoc = Sheet2.Range("F" & TemplRow).Value 'Word Document Filename

    'Open Word Template
    On Error Resume Next 'If Word is already running
    Set WordApp = GetObject("Word.Application")
    If Err.Number <> 0 Then
    'Launch a new instance of Word
    Err.Clear
    'On Error GoTo Error_Handler
    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = True 'Make the application visible to the user
    End If


    LastRow = .Range("c400").End(xlUp).Row  'Determine Last Row in Table
        For CustRow = 8 To LastRow
                PrintStatus = .Range("d" & CustRow).Value


                If PrintStatus = "Ready" Then
                                Set WordDoc = WordApp.Documents.Open(FileName:=DocLoc, ReadOnly:=False) 'Open Template
                                For CustCol = 4 To 19 'Move Through 9 Columns
                                    TagName = .Cells(7, CustCol).Value 'Tag Name
                                    TagValue = .Cells(CustRow, CustCol).Value 'Tag Value
                                     With WordDoc.Content.Find
                                        .Text = TagName
                                        .Replacement.Text = TagValue
                                        .Wrap = wdFindContinue
                                        .Execute Replace:=wdReplaceAll 'Find & Replace all instances
                                     End With


                                Next CustCol
                                    .Range("d" & CustRow).Value = "Done"
                                       FileName = ThisWorkbook.Path & "\" & .Range("c" & CustRow).Value & "_" & .Range("i" & CustRow).Value & ".docx"
                                       WordDoc.SaveAs FileName
                                .Range("d" & CustRow).Value = "Done"






                                          ' WordDoc.Close
                                    End If
                        Kill (FileName) 'Deletes the PDF or Word that was just created

        Next CustRow
        WordApp.Quit
End With
End Sub

1 个答案:

答案 0 :(得分:0)

选择打印机

Application.ActivePrinter = Printers(2) ' set index to correct printer in the printers collection

打印命令语句

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
    IgnorePrintAreas:=False

消息

MsgBox "The sheet was printed."