打印为 PDF 时，Word 宏从 excel sheet 重命名文件

Question

我已经根据 Excel sheet 的输入设置了邮件合并来草拟信件。 Post 草稿完成。我有 Word VBA 代码可以将每一页打印为 PDF。目前它要求我手动输入保存文件夹和文件名。如何在以下代码中合并要从 excelsheet 中选择的文件夹位置和文件名：

Sub Print_letter()
Dim x As Long, StrPrtr As String
StrPrtr = Application.ActivePrinter
Application.ActivePrinter = "microsoft print to pdf"
With ActiveDocument
  For x = 1 To .ComputeStatistics(wdStatisticPages)
    Application.PrintOut PrintToFile:=False, FileName:="", _
      Range:=wdPrintRangeOfPages, Pages:=CStr(x), Item:=wdPrintDocumentWithMarkup, _
      Background:=True, PageType:=wdPrintAllPages, Copies:=1, Collate:=False, _
      PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, PrintZoomPaperHeight:=0
  Next x
End With
Application.ActivePrinter = StrPrtr
End Sub

Answer 1

你什么都不说，我要离开办公室了...

请尝试下一个代码，能够定义 Excel 工作簿的范围：

'It needs a reference to 'Microsoft Excel ... Object library'
Function getRangefromExcelSession(strWorkbook As String, strSheet As String) As Excel.Range
  Dim Ex As Excel.Application, ws As Worksheet, wb As Workbook, rng As Range
  Dim wbFound As Workbook, Boolfound As Boolean, lastRow As Long
  
   On Error Resume Next
    Set Ex = GetObject(, "Excel.Application")
     If Err.Number = 0 Then
        Err.Clear: On Error GoTo 0
        For Each wb In Ex.Workbooks
            If wb.Name = strWorkbook Then
                Set wbFound = wb
                Boolfound = True
            End If
        Next
     Else
       On Error GoTo 0
       MsgBox "There is not any Excel session open...", vbInformation, "Ups...": Exit Function
     End If
     If Boolfound Then
        Set ws = wbFound.Worksheets(strSheet)
        lastRow = ws.Range("F" & ws.Rows.count).End(xlUp).row
        Set getRangefromExcelSession = ws.Range("F2:F" & lastRow)
     End If
End Function

没有提供错误处理以防找不到（您的）workbook/sheet...

需要的范围可以这样得到：

Sub testBetRangeFromExcelSess()
    Dim rng As Excel.Range, cel As Range
    Set rng = getRangefromExcelSession("Your workbook name", "Your sheet name")
    If Not rng Is Nothing Then
        Debug.Print rng.Address
        For Each cel In rng
            Debug.Print cel.Value
        Next
    End IfWindow
End Sub

已编辑：

您修改后的代码应如下所示：

Sub Print_letter()
Dim x As Long, StrPrtr As String
StrPrtr = Application.ActivePrinter
Application.ActivePrinter = "microsoft print to pdf"

Dim rng As Excel.Range
Set rng = getRangefromExcelSession("Workbook name", "sheet name")

With ActiveDocument
  For x = 1 To .BuiltInDocumentProperties("Number of Pages")
    Application.PrintOut PrintToFile:=False, OutputFileName:="C:\" & rng(x, 1).Value & ".pdf", _
      Range:=wdPrintRangeOfPages, Pages:=CStr(x), Item:=wdPrintDocumentWithMarkup, _
      background:=True, PageType:=wdPrintAllPages, Copies:=1, Collate:=False, _
      PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, PrintZoomPaperHeight:=0
  Next x
End With
Application.ActivePrinter = StrPrtr
End Sub

第二次编辑:

请尝试运行下一个测试代码：

Sub testPrintToPdf_() 
 Dim StrPrtr As String, x As Long
 StrPrtr = Application.ActivePrinter
 Application.ActivePrinter = "microsoft print to pdf"
 
 With ActiveDocument
    For x = 1 To .BuiltInDocumentProperties("Number of Pages")
        Application.PrintOut PrintToFile:=False, OutputFileName:="C:\testdDoc_" & x & ".pdf", _
          Range:=wdPrintRangeOfPages, Pages:=CStr(x), Item:=wdPrintDocumentWithMarkup, _
          Background:=True, PageType:=wdPrintAllPages, Copies:=1, Collate:=False, _
          PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, PrintZoomPaperHeight:=0
    Next x
 End With
End Sub

应该return 15个文档命名为“testDoc_1,pdf”, “testDoc_2,pdf”等等...

打印为 PDF 时，Word 宏从 excel sheet 重命名文件

Word Macro renaming file from excel sheet while printing as PDF

vba

ms-word