Question

我有代码选择要打印到pdf文档的工作表数组，但是我正在尝试使用一系列对应于特定工作表的复选框来实现用户表单。

以下代码选择预定的工作表数组并将其打印为pdf

Sub PDFAllSheets_Click()

Dim ws As Worksheet
Dim strPath As String
Dim myfile As Variant
Dim strFile As String
Dim sheetstoprint As String

On Error GoTo errHandler

Set ws = ActiveSheet

strFile = "E_CALC_" & Worksheets("Contents").Range("H7").Text & ".pdf"

strFile = ThisWorkbook.Path & "\" & strFile

myfile = Application.GetSaveAsFilename _
    (InitialFileName:=strFile, _
    FileFilter:="PDF Files (*.pdf), *.pdf", _
    title:="Select Folder and FileName to save")

If myfile <> "False" Then

    ThisWorkbook.Sheets(Array("Engine", "CHP Layout", "Ventilation", "Exhaust", "Gas", "Hazardous Zoning", "Gas Ramp up", "Steam Boilers", _
                        "JW PU", "AC PU", "Combustion", "BREEAM NOx", "Pump P1", "Pump P2", "Pump P3", "Pump P4", "Pump P5")).Select

    ActiveSheet.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    FileName:=myfile, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=True

    MsgBox "PDF file has been created."

End If

exitHandler:
Exit Sub

errHandler:
MsgBox "Could not create PDF file", vbRetryCancel, "Oops!"

Resume exitHandler

End Sub

我需要以下UserForm的复选框来定义要包含在数组中的工作表。

UserForm1

Answer 1

如果你有一个带有ListBox和CommandButton的UserForm，这应该有效，假设你有你指定的名字。

此代码当然应该添加到UserForm代码模块中。

Private Sub CommandButton1_Click()

Dim SheetArray() As Variant
Dim indx As Integer

Dim ws As Worksheet
Dim strPath As String
Dim myfile As Variant
Dim strFile As String
Dim sheetstoprint As String

On Error GoTo errHandler

Set ws = ActiveSheet

strFile = "E_CALC_" & Worksheets("Contents").Range("H7").Text & ".pdf"

strFile = ThisWorkbook.Path & "\" & strFile

myfile = Application.GetSaveAsFilename _
    (InitialFileName:=strFile, _
    FileFilter:="PDF Files (*.pdf), *.pdf", _
    Title:="Select Folder and FileName to save")

If myfile <> "False" Then

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    indx = 0
    For i = 0 To ListBox1.ListCount - 1
            If ListBox1.Selected(i) = True Then
                ReDim Preserve SheetArray(indx)
                SheetArray(indx) = Sheets(ListBox1.List(i, 1)).Index
                indx = indx + 1
            End If
    Next i

    If indx > 0 Then

            Sheets(SheetArray()).Select
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                Filename:=myfile, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=True


                '.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myfile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True


    End If
End If
exitHandler:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub

errHandler:
MsgBox "Could not create PDF file", vbRetryCancel, "Oops!"

Resume exitHandler
End Sub

Private Sub UserForm_Initialize()

Dim wks() As Variant


wks = Array("Engine", "CHP Layout", "Ventilation", "Exhaust", "Gas", "Hazardous Zoning", "Gas Ramp up", "Steam Boilers", _
                        "JW PU", "AC PU", "Combustion", "BREEAM NOx", "Pump P1", "Pump P2", "Pump P3", "Pump P4", "Pump P5")

'Debug.Print wks(16)
For i = 0 To UBound(wks)

        ListBox1.AddItem wks(i)
        ListBox1.List(ListBox1.ListCount - 1, 1) = wks(i)

Next i


End Sub

请记住在列表框属性窗口中允许列表框多选。

编辑：在我的测试过程中，Excel应用程序似乎在导出PDF后冻结。我不知道它是否与OpenAfterPublish属性设置为True有关，因为我总是把它设置为False。

EDIT2：

我的错误，这只是因为UserForm仍处于打开状态......

在用户表单中选中复选框以选择要打印的表格

1 个答案: