michele227
New Member
- Joined
- Feb 15, 2023
- Messages
- 15
- Office Version
- 2019
- Platform
- Windows
Hi everyone,
I am brand new to VBA!
I am currently working on a VBA that merges multiple selected .png files into one .pdf.
Each image to be the full size of a separate page.
It starts by opens up a file dialog to a specific path.
It then allows you to pick multiple image files.
It then creates a new sheet per image selected named "Sketch1," "Sketch2," etc.
It then pastes each image per sheet.
All of the new sheets are then selected and saved as a pdf.
All new sheets are then deleted.
This is my code currently.
I managed to make it work with 2 images but I can't make it work with 3, 4, or more images.
It ends up pasting 3 images in "Sketch1" and 1 image in "Sketch 4,"
I am also sure there is a better way to condense the code but I can't wrap my brain around loops or integers.
I would really appreciate some guidance .
Thank you in advance!
I am brand new to VBA!
I am currently working on a VBA that merges multiple selected .png files into one .pdf.
Each image to be the full size of a separate page.
It starts by opens up a file dialog to a specific path.
It then allows you to pick multiple image files.
It then creates a new sheet per image selected named "Sketch1," "Sketch2," etc.
It then pastes each image per sheet.
All of the new sheets are then selected and saved as a pdf.
All new sheets are then deleted.
This is my code currently.
I managed to make it work with 2 images but I can't make it work with 3, 4, or more images.
It ends up pasting 3 images in "Sketch1" and 1 image in "Sketch 4,"
I am also sure there is a better way to condense the code but I can't wrap my brain around loops or integers.
I would really appreciate some guidance .
Thank you in advance!
Sub SavePNGtoPDF()
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim sheetArray As Variant
Dim pdfname As String
Dim pdfpath As String
pdfname = Sheets("Sheet1").Range("Q2").Value
pdfpath = Sheets("Sheet1").Range("O17").Value
Set xFileDlg = Application.FileDialog(msoFileDialogFilePicker)
xFileDlg.InitialFileName = pdfpath
xFileDlg.AllowMultiSelect = True
If xFileDlg.Show = 0 Then
Exit Sub
End If
If xFileDlg.SelectedItems.Count = 4 Then
Sheets.Add.Name = "Sketch1"
With ActiveSheet.PageSetup
.PaperSize = xlPaperLegal
.Orientation = xlLandscape
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.15)
.RightMargin = Application.InchesToPoints(0.15)
.TopMargin = Application.InchesToPoints(0.15)
.BottomMargin = Application.InchesToPoints(0.15)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = True
.Zoom = 150
End With
Sheets.Add.Name = "Sketch2"
With ActiveSheet.PageSetup
.PaperSize = xlPaperLegal
.Orientation = xlLandscape
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.15)
.RightMargin = Application.InchesToPoints(0.15)
.TopMargin = Application.InchesToPoints(0.15)
.BottomMargin = Application.InchesToPoints(0.15)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = True
.Zoom = 150
End With
Sheets.Add.Name = "Sketch3"
With ActiveSheet.PageSetup
.PaperSize = xlPaperLegal
.Orientation = xlLandscape
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.15)
.RightMargin = Application.InchesToPoints(0.15)
.TopMargin = Application.InchesToPoints(0.15)
.BottomMargin = Application.InchesToPoints(0.15)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = True
.Zoom = 150
End With
Sheets.Add.Name = "Sketch4"
With ActiveSheet.PageSetup
.PaperSize = xlPaperLegal
.Orientation = xlLandscape
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.15)
.RightMargin = Application.InchesToPoints(0.15)
.TopMargin = Application.InchesToPoints(0.15)
.BottomMargin = Application.InchesToPoints(0.15)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = True
.Zoom = 150
End With
For Each xSelItem In xFileDlg.SelectedItems
Set myPic = ActiveSheet.Pictures.Insert(xSelItem)
Sheets(Array("Sketch1", "Sketch2", "Sketch3", "Sketch4")).Select
Next
ElseIf xFileDlg.SelectedItems.Count = 2 Then
Sheets.Add.Name = "Sketch1"
With ActiveSheet.PageSetup
.PaperSize = xlPaperLegal
.Orientation = xlLandscape
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.15)
.RightMargin = Application.InchesToPoints(0.15)
.TopMargin = Application.InchesToPoints(0.15)
.BottomMargin = Application.InchesToPoints(0.15)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = True
.Zoom = 150
End With
Sheets.Add.Name = "Sketch2"
With ActiveSheet.PageSetup
.PaperSize = xlPaperLegal
.Orientation = xlLandscape
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.15)
.RightMargin = Application.InchesToPoints(0.15)
.TopMargin = Application.InchesToPoints(0.15)
.BottomMargin = Application.InchesToPoints(0.15)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = True
.Zoom = 150
End With
For Each xSelItem In xFileDlg.SelectedItems
Set myPic = ActiveSheet.Pictures.Insert(xSelItem)
Sheets(Array("Sketch1", "Sketch2")).Select
Next
End If
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:=pdfpath & pdfname & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Set myPic = Nothing
Set NewSheet = Nothing
Set MyFolder = Nothing
Set FSO = Nothing
End Sub