选中要打印的 select 张用户表单中的复选框
Check boxes in user form to select sheets to print
我有选择要打印到 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
我需要以下用户窗体的复选框来定义要包含在数组中的工作表。
如果您有一个带有列表框和命令按钮的用户窗体,这应该可以工作,假设您有按您指定的名称命名的工作表。
这段代码当然应该添加到用户窗体代码模块中。
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
记得在列表框属性中允许列表框多选 window。
编辑:
在我的测试过程中,Excel 应用程序似乎在导出 PDF 后冻结。我不知道它是否与 OpenAfterPublish 属性 设置为 True 有任何关系,因为我一直将其设置为 False。
编辑2:
我的错误,这仅仅是因为用户窗体仍然打开...
我有选择要打印到 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
我需要以下用户窗体的复选框来定义要包含在数组中的工作表。
如果您有一个带有列表框和命令按钮的用户窗体,这应该可以工作,假设您有按您指定的名称命名的工作表。
这段代码当然应该添加到用户窗体代码模块中。
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
记得在列表框属性中允许列表框多选 window。
编辑: 在我的测试过程中,Excel 应用程序似乎在导出 PDF 后冻结。我不知道它是否与 OpenAfterPublish 属性 设置为 True 有任何关系,因为我一直将其设置为 False。
编辑2:
我的错误,这仅仅是因为用户窗体仍然打开...