通过 CutePDF Writer 打印所有工作表

Question

我使用的是来自this topic 的 .ExportAsFixedFormat，但不幸的是，Printed PDF 在格式和符号方面存在一些问题。

我试过CutePDF Writer，没问题。

现在，我想选择所有工作表并打印为单个文件，与 .ExportAsFixedFormat 函数一样

是否有任何快捷方式可以选择所有工作表并通过 VBA 将它们打印为 PDF？

我尝试插入一个数组，我用工作表名称填充了该数组。但我有一个类型不匹配的错误。

Private Sub CommandButton9_Click()

Dim SNarray, i
Dim Filename As String

Filename = "E:\TestMe1.pdf"


ReDim SNarray(1 To Sheets.Count)
For i = 1 To Sheets.Count
    SNarray(i) = ThisWorkbook.Sheets(i).name
Debug.Print SNarray(i)
Next



Application.ActivePrinter = "CutePDF Writer on CPW2:"
Sheets(SNarray()).Select 'Here is the TYPE MISMATCH
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:="CutePDF Writer on CPW2:", PrintToFile:=True, Collate:=True, prtofilename:=Filename

End Sub

谢谢！

Answer 1

一些事情：

从您的 select 语句中的数组中删除括号

Sheets(SNarray).Select

确保您的所有工作表都可见，否则您将收到Select method of Sheets class failed 错误。这不是您现在所得到的，但如果有可能隐藏工作表，您可能需要为其编写代码。此外，如果有人添加图表表或宏表并且您想跳过它，您可能需要为此编写代码。

Sub test()

    Dim SNarray() As String
    Dim i As Long
    Dim lCnt As Long

    For i = 1 To ThisWorkbook.Sheets.Count
        If ThisWorkbook.Sheets(i).Type = xlWorksheet And _
            ThisWorkbook.Sheets(i).Visible = xlSheetVisible Then

            lCnt = lCnt + 1
            ReDim Preserve SNarray(1 To lCnt)
            SNarray(lCnt) = ThisWorkbook.Sheets(i).Name
        End If
    Next i

    ThisWorkbook.Sheets(SNarray).Select

End Sub

最后，当您在不指定工作簿的情况下使用Sheets 时，如果您在标准模块中，您实际上是在使用ActiveWorkbook.Sheets，如果您在ThisWorkbook 模块中，您实际上是在使用ThisWorkbook.Sheets。只要 ThisWorkbook 处于活动状态，就可以。但如果不是，您的 Sheets.Count 可能会返回与 ThisWorkbook.Sheets(i).Name 预期不同的内容。一般来说，总是限定你的参考。 With 块对此很有用。

Sub test()

    Dim SNarray() As String
    Dim i As Long
    Dim lCnt As Long

    With ThisWorkbook
        For i = 1 To .Sheets.Count
            If .Sheets(i).Type = xlWorksheet And _
                .Sheets(i).Visible = xlSheetVisible Then

                lCnt = lCnt + 1
                ReDim Preserve SNarray(1 To lCnt)
                SNarray(lCnt) = .Sheets(i).Name
            End If
        Next i

        .Sheets(SNarray).Select

    End With

End Sub