vArray if else macro - vba

I am trying to create a macro the adds different pages to a pdf based on a check box status. This is what I currently have.
Sub ToyotaMO()
'
' ToyotaMO Macro
'
Sheets("TC").Visible = True
Sheets("BS").Visible = True
Sheets("ToyotaMO").Activate
If Sheets("ACM").OLEObjects("Toyota").Object.Value = True Then
vArray = Array("ToyotaMO", "TC", "BS")
Else
vArray = Array("Proposal", "TC")
End If
ThisWorkbook.Sheets(vArray).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & ActiveSheet.Range("C5").Value & " Toyota Material Only ACM Proposal" & Format(Date, " MMDDYY") & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
Sheets("ToyotaMO").Activate
Range("A1").Select
Sheets("TC").Visible = False
Sheets("BS").Visible = False
Sheets("ACM").Select
Range("B1").Select
End Sub
The macro works on all the other forms the only difference is I need to add worksheet "BS" to the PDF if the checkbox is checked. VBA always stalls at ThisWorkbook.Sheets(vArray).Select.
Any help is greatly appreciated

Try the following, this will loop through your array and do what you expect:
Sub ToyotaMO()
'
' ToyotaMO Macro
'
Sheets("TC").Visible = True
Sheets("BS").Visible = True
Sheets("ToyotaMO").Activate
If Sheets("ACM").OLEObjects("Toyota").Object.Value = True Then
vArray = Array("ToyotaMO", "TC", "BS")
Else
vArray = Array("Proposal", "TC")
End If
For i = LBound(vArray) To UBound(vArray)
ThisWorkbook.Sheets(vArray(i)).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & ActiveSheet.Range("C5").Value & " Toyota Material Only ACM Proposal" & Format(Date, " MMDDYY") & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
Sheets("ToyotaMO").Activate
Range("A1").Select
Sheets("TC").Visible = False
Sheets("BS").Visible = False
Sheets("ACM").Select
Range("B1").Select
Next i
End Sub

Related

Saving Multiple Ranges on two different sheets to PDF using VBA

I need to get both of these sheets and ranges to be combined into ONE PDF. I have tried all of the macros I can find and none of them work. Here is the Macro I'm working with, which all works except for the ranges being combined in one Doc
Private Sub SaveLHForms()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
FormName = Sheets("SETUP").Range("B2").Value & " " & ActiveSheet.Range("S1") & ".pdf"
ChDir DesktopAddress
Sheets("Lienholder Docs").Range("A45:I151").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
FormName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
Sheets("Settlement Letters").Range("A47:I92").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
FormName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
First, you need to create a pdf document after setting the print area in the page settings of each sheet.
Sub test()
Dim path As String
Dim myArr As Variant, a As Variant
Dim rngArr As Variant
Dim Ws As Worksheet
Dim formName As String
Dim i As Integer
formName = Sheets("SETUP").Range("B2").Value & " " & ActiveSheet.Range("S1") & ".pdf"
myArr = Array("Lienholder Docs", "Settlement Letters") '<~~ Sheet name
rngArr = Array("A45:I151", "A47:I92") '<~~ print area address
For i = 0 To UBound(myArr)
Set Ws = Sheets(myArr(i))
With Ws
.PageSetup.PrintArea = .Range(rngArr(i)).Address
End With
Next a
Sheets(myArr).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
formName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
End Sub
This may work:
Sub Macro1()
Sheets("Lienholder Docs").Activate
ActiveSheet.Range("A45:I151").Select
Sheets("Settlement Letters").Activate
ActiveSheet.Range("A47:I92").Select
Sheets(Array("Lienholder Docs", "Settlement Letters")).Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
FormName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
End Sub
Based on:
Excel VBA to Export Selected Sheets to PDF
EDIT#1:
This version should un-do any grouping:
Sub Macro2()
Dim s As Worksheet
Set s = ActiveSheet
FormName = "C:\TestFolder\xxx.pdf"
Sheets("Lienholder Docs").Activate
ActiveSheet.Range("A45:I151").Select
Sheets("Settlement Letters").Activate
ActiveSheet.Range("A47:I92").Select
Sheets(Array("Lienholder Docs", "Settlement Letters")).Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
FormName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
s.Activate
End Sub

I have a macro that creates individual PDFs for a set of tabs. Is there a way to add a step and combine all the PDFs into one file?

I have a macro that creates individual PDFs for a set of tabs. Is there a way to add a step and combine all the PDFs into one file?
Sub Print_Exhibit()
Dim Numb_Exhibit As Double
Dim File_Location As String
Dim Sheet_Name As String
Dim X As Double
Dim Y As Double
Numb_Exhibit = WorksheetFunction.Max(Sheets("Control - Exhibit
Key").Range("B:B"))
File_Location = Sheets("Control - Exhibit Key").Range("K6").Value
For X = 1 To Numb_Exhibit
Y = 8 + X
Sheet_Name = Sheets("Control - Exhibit Key").Range("E" & Y).Value
Sheets(Sheet_Name).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:=File_Location
& "\" & Sheet_Name & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True,
IgnorePrintAreas _
:=False, OpenAfterPublish:=True
Next
End Sub
Thank you so much for your help!
Loop through all tabs, copy and paste into a new common tab. Export it.
Did you do a prerequisite Google search before posting here?
Save multiple sheets to .pdf
Public Sub subCreatePDF()
If Not IsPDFLibraryInstalled Then
'Better show this as a userform with a proper link:
MsgBox "Please install the Addin to export to PDF. You can find it at http://www.microsoft.com/downloads/details.aspx?familyid=4d951911-3e7e-4ae6-b059-a2e79ed87041".
Exit Sub
End If
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ActiveWorkbook.Path & Application.PathSeparator & _
ActiveSheet.Name & " für " & Range("SelectedName").Value & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub
Private Function IsPDFLibraryInstalled() As Boolean
'Credits go to Ron DeBruin (http://www.rondebruin.nl/pdf.htm)
IsPDFLibraryInstalled = _
(Dir(Environ("commonprogramfiles") & _
"\Microsoft Shared\OFFICE" & _
Format(Val(Application.Version), "00") & _
"\EXP_PDF.DLL") <> "")
End Function
OR
ThisWorkbook.Sheets(Array("Sheet1", "Sheet2")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\tempo.pdf", Quality:= xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
ALSO
https://danwagner.co/how-do-i-save-multiple-sheets-as-a-single-pdf/

Conditional Statement within Loop

What am i doing wrong? I want to create pdf files of a tab that runs through a list in column A from a different tab. Meanwhile, I want it to refer to the value in column CH to see if it is greater than 0 and if it is so save in a specific folder. If not, save in another folder.
Help is greatly appreciated as I can't find a solution and have been stuck for hours. Thanks!
Code:
Sub Generate_PDF_Files()
Application.ScreenUpdating = False
Sheets("Table").Activate
Range("A7").Activate
Set r = Range("CH7:CH185")
With ActiveSheet
For Each erange In .Range("CH7:CH185")
If erange.Value > 0 Then
Sheets("Att A").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"L:\Mike89\Violations\" & X & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End If
If erange.Value = 0 Then
Sheets("Att A").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"L:\Mike89\No Violations\" & X & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False,OpenAfterPublish:=False
End If
Next
Do Until ActiveCell.Value = "STOP"
X = ActiveCell.Value
Range("DLR_NUM") = "'" & X
Sheets("Table").Activate
ActiveCell.Offset(1, 0).Activate
Loop
End with
End Sub
Sub Generate_PDF_Files()
Dim c As Range, X, fName As String, shtAtt As Worksheet
Set shtAtt = Sheets("Att A")
For Each c In Sheets("Table").Range("CH7:CH185").Cells
X = c.EntireRow.Cells(1).Value
If X = "STOP" Then Exit For
c.Parent.Range("DLR_NUM") = "'" & X
fName = "L:\Mike89\" & IIf(c.Value = 0, "No Violations\", "Violations\") & X & ".pdf"
shtAtt.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Next c
End Sub

Excel VBScript to close the openeded and previously printed PDF before printing to another PDF

I am printing worksheets to one single PDF file with one chunk of code. With this PDF file open, If I attempt another print to PDF from this same excel file I get a VB error: "Document not saved" and debug takes me here in the code:
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:= _
strFilename & " " & wedate_text & " Time", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
HERE IS CODE:
Sub PrintAnadarkoTicketsToPDF()
Worksheets("Cover").Visible = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Dim strFilename As String
Dim rngRange As Range
Dim wedate As Date
Dim wedate_text As String
Set rngRange = Worksheets("Cover").Range("A5")
strFilename = rngRange.Value
wedate = Worksheets("Cover").Range("B24").Value
wedate_text = Format$(wedate, "mm.dd.yyyy")
Dim myArray() As Variant
Dim i As Integer
Dim j As Integer
j = 0
For i = 1 To Sheets.Count
If Sheets(i).Visible = True Then
ReDim Preserve myArray(j)
myArray(j) = i
j = j + 1
End If
Next i
Sheets(myArray).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:= _
strFilename & " " & wedate_text & " Time", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
Worksheets("Cover").Visible = True
Sheets(1).Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
End Sub
My question is: How do I print this second PDF without crashing the script? I would like to close the previous PDF or create the second PDF with a different file name. Thanks for the suggestions.
Randy
I'm not sure why you want to have a loop that counts the number of non-hidden sheets. Plus, you could export the sheets inside that loop. That may fix your issue:
For i = 1 To Sheets.Count
If Sheets(i).Visible = True Then
Sheets(i).ExportAsFixedFormat Type:=xlTypePDF, filename:= _
strFilename & Trim(Str(i)) & " " & wedate_text & " Time", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
End If
Next i
Note also the addition of the workbook number to the file name, because it's trying to save to the same file.

Save sheets as pdf

I have this problem trying to print multiple sheets in a single pdf. Browsing online and in the forum i found this code but when i use it i get the ERROR 9 "Subscript out of range" and I don't understand why. I tried in a new workbook the code and it works properly. Can someone help me?
Private Sub cmd_PrintPDF_Click()
ThisWorkbook.Sheets(Array("Costs", "Cars")).Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "/" & "Cost&Car", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub
This macro runs from the main panel of my workbook, where there are various Command buttons that direct you in requested sheets.When i run this macro the sheet "Cars" is hidden, may be is this the problem? I tried with an .Activate before the code but it still doesn't work.
I use this code for export sheets to pdf. Maybe will be useful for you.
Sub SheetsToPdf()
Dim Arr() As String
Dim PdfFileName As String
PdfFileName = "Cost&Car"
ReDim Arr(1, 1)
'sheets name in 1st column, 2nd column for info about visibility sheets
Arr(0, 0) = "Costs"
Arr(1, 0) = "Cars"
Cells(1, 1).Select
For i = LBound(Arr, 1) To UBound(Arr, 1)
Arr(i, 1) = ThisWorkbook.Sheets(Arr(i, 0)).visible ' info about visibility sheets
If Arr(i, 1) = "0" Then 'check visible Sheets "-1" - visible = True, "0" - visible = False
ThisWorkbook.Sheets(Arr(i, 0)).visible = True
OrgVisible = False
End If
If i = 0 Then
ThisWorkbook.Sheets(Arr(i, 0)).Select
Else
ThisWorkbook.Sheets(Arr(i, 0)).Select False 'select all sheets with names in arr()
End If
Next i
'select all data
Cells.Select
'export to pdf
Selection.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
ThisWorkbook.path & "/" & PdfFileName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
'restore old visibility for sheets
For i = LBound(Arr, 1) To UBound(Arr, 1)
If Arr(i, 1) = "0" Then 'set old visible
ThisWorkbook.Sheets(Arr(i, 0)).visible = False
End If
Next i
End Sub
Maybe this simpler version you need? Exports only visible sheets:
Sub SheetsToPdf2()
Dim PdfFileName As String
PdfFileName = "Cost&Car"
Cells(1, 1).Select
For Each Sheets_ In Sheets
If Sheets_.visible Then
ThisWorkbook.Sheets(Sheets_.Name).Select False
End If
Next
'select all data in one sheet
Cells.Select
'export to pdf
Selection.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
ThisWorkbook.path & "/" & PdfFileName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub
Indeed, you can't print an hidden sheet
And here is your code without the useless and ressource-greedy Select :
Private Sub cmd_PrintPDF_Click()
ThisWorkbook.Sheets("Costs").Visible = True
ThisWorkbook.Sheets("Cars").Visible = True
ThisWorkbook.Sheets(Array("Costs", "Cars")).ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=ThisWorkbook.Path & "/" & "Cost&Car", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
ThisWorkbook.Sheets("Costs").Visible = False
ThisWorkbook.Sheets("Cars").Visible = False
End Sub