vba - 通过 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

一些东西:

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

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.Sheets如果您在 ThisWorkbook 模块中。只要 ThisWorkbook 处于事件状态，就可以。但如果没有，您的 Sheets.Count可能返回不同于 ThisWorkbook.Sheets(i).Name 的内容预计。一般来说，总是限定你的引用。一个 With block 对此有好处。

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