Code: Select all
Private Sub CommandButton5_Click()
'Microsoft PDF
Dim blnSelected As Boolean
Dim wshI As Worksheet
Dim lngPage As Long
Dim lngRow As Long
Dim i As Long
Dim arrSheets As Variant
Dim arrNames As Variant
'The order of array reflects order of index page
arrSheets = Array("Cover Page", "Index", "Client Information", "Summary", "Utilities", "Grounds", "Structural Systems", _
"Detached Structure", "Roof & Attic", "Fireplace & Chimney", "Interior", "Bedroom", "Laundry", "Bathroom(s)", "Kitchen", _
"Kitchen Appliances", "Heating and Cooling", "Water Heater", "Pool Spa", "Additional Photos", "Informational")
arrNames = Array("Cover Page", "Index", "Client Information", "Summary", "Utilities", "Exterior Surfaces", "Interior Surfaces", _
"Detached Structure", "Roof & Attic", "Fireplace & Chimney", "Interior", "Bedroom", "Laundry", "Bathroom(s)", "Kitchen", _
"Kitchen Appliances", "Heating and Cooling", "Water Heater", "Pool Spa", "Additional Photos", "Laboratory Results")
ActiveWorkbook.Protect Password:="benji", Structure:=False, Windows:=False
Sheets("Index").Unprotect ""
Application.ScreenUpdating = False
If CheckBox2.Value = True Then
Sheets("Index").Visible = xlSheetVisible
Else
Sheets("Index").Visible = xlSheetHidden
End If
Set wshI = Worksheets("Index")
lngPage = 1
lngRow = 6
wshI.Cells.ClearContents
Sheets("Index").Range("B3").Value = " Inspection Report Directory "
Sheets("Index").Range("B5").Value = " Inspected locations "
Sheets("Index").Range("C5").Value = " Page # "
For i = 1 To 21
If Me.Controls("CheckBox" & i).Value And Sheets(arrSheets(i - 1)).Visible = xlSheetVisible Then
wshI.Range("B" & lngRow) = arrNames(i - 1)
wshI.Range("C" & lngRow) = lngPage
lngRow = lngRow + 1
Sheets(arrSheets(i - 1)).Activate
lngPage = lngPage + Application.ExecuteExcel4Macro("Get.Document(50)")
End If
Next i
For i = 1 To 21
If Me.Controls("CheckBox" & i).Value And Sheets(arrSheets(i - 1)).Visible = xlSheetVisible Then
Sheets(arrSheets(i - 1)).Select Replace:=Not blnSelected
blnSelected = True
End If
Next i
If blnSelected = True Then
Dim WSHShell As Object
Dim DesktopPath As String
Dim strFileName As String
Set WSHShell = CreateObject("WScript.Shell")
DesktopPath = WSHShell.SpecialFolders("Desktop")
Set WSHShell = Nothing
strFileName = DesktopPath & "\" & ActiveWorkbook.Name
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strFileName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Unload Me
Unload UserForm4
Sheets("Index").Visible = xlSheetHidden
ActiveWorkbook.Protect Password:="", Structure:=True, Windows:=True
MsgBox "Your PDF report has been placed on your Desktop"
Else
MsgBox "No check boxes were selected and/or selections not open"
Sheets("Index").Visible = xlSheetHidden
ActiveWorkbook.Protect Password:="", Structure:=True, Windows:=True
End If
Application.ScreenUpdating = True
End Sub