Print to PDF Macro, or possibly more

Cliffork

Cliffork

New Member
Joined
Feb 12, 2020
Messages
43
Office Version
  1. 365
I have a compilation file that we fill in calibration forms for a device on. There are a handful of sheets in the workbook, but every since one has a sheet named "Cal Form" that I am trying to automate printing a PDF of, with the name being pulled from two cells in said sheet (C8 and K8).

If possible I'm also trying to find some way to print PDF's of dozens of existing Cal Forms as my customers request them all the time, and getting them is tedious. I'm not sure what the best way to do this would be.
I have hundreds of these files and it would honestly be convenient to just be able to print every single one to PDF automatically somehow.

I've tried searching the forums and just googling but it seems everyone is trying to do something differently and I've tried 2 so far with no luck on my end. I've also tried recording a macro of saving it as a PDF but it doesn't appear to function.

Code for my recorded macro that doesn't seem to work is
VBA Code: 
Sub PrintToPDF()
'
' PrintToPDF Macro
'
' Keyboard Shortcut: Ctrl+q
'
    ChDir "Z:\Shared\EEW\Lab\Cal Cert PDF"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "Z:\Shared\EEW\Lab\Compilation Documents\Envision\Meter Repair Compilation File -Template.pdf" _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
End Sub


Sheet is below in case it helps.

Meter Repair Compilation File -TemplateTEST.xlsm
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAE
2Testing and Calibration Report
3
4
7
8Date:10/29/2024Meter SN#: 1234567BModel #:ENV200RMA#:0500-1234
9Lab Testing Performed
10 Bluetooth Battery Charger Available Pressure CH4 Sensor H2S Sensor
11 Firmware Battery health Impact Pressure CO2 Sensor CO Sensor
12 Thermistor Static Pressure Seal Integrity O2 Sensor H2 Sensor
13
14Calibration Results:
15GasTarget Value 1Analyzer Value 1Target Value 2Analyzer Value 2Calibration Gas Bottle Lot#Analytical Uncertainty
16A20.9% O220.9% O20.00--32-401209938-1± 0.02% abs
17B11% O211% O20.00--32-401919744-1± 0.02% abs
18C50% CH435% CO250% CH40.0035% CO20.00141-403023316-1± 0.02% abs
19D15% CH415% CO215% CH40.0015% CO20.00141-402762057-1± 2% rel
20E40% CH460% CO240% CH40.0060% CO20.00141-403007833-1± 1% rel
21F100% CO2--100% CO20.0025-401897982-1- 0.01% abs
22G100% CH4100% CH40.00--141-402357134-1- 0.5% abs
27
28Zero Gas ValueCH4CO2O2H2H2SCO
29L99.999% N20.000.000.000.000.000.00
30Calibration Gas directly traceable to NIST ASTM Class 1 weights and/or NIST gas mixture reference materials
31Pressure Sensors: (All measurements made in"WC)
32Low PressuresHigh Pressures
33SensorTarget Value 1Analyzer Value 1Target Value 2Analyzer Value 2SensorTarget Value 1Analyzer Value 1Target Value 2Analyzer Value 2
34Applied0.0000.00-4.500.00Available0.0000.00-100.000.00
35Diff.0.0000.0004.5000.000Diff.0.0000.0020.0000.00
36Applied0.0000.000-100.000.000
37This device has passed testing and calibration procedures as specified by Elkins Earthworks, LLC.
38
39Calibrated by (Signature):KC
40
41At Elkins Earthworks we appreciate your business. We strive for a standard 10 working day turn arround on all calibrations and repairs from the time we have received your instrument. Your instrument has been serviced in 32559 days. We hope you appreciate our dedication to service and quality.
42
43
44Thanks,Notes as to why service exceeded 10 day turn
45
46
47
48
49President
50Elkins Earthworks, LLC.
51
52
53
54
Cal Form
Cell Formulas
RangeFormula
K8K8=('Customer Info'!B15)
R8R8='Customer Info'!B16
Y8Y8=('Customer Info'!B13)
B10B10=IF(ISNUMBER(SEARCH("X",'Final Insp.'!A13)),"P", "")
B11B11=IF(ISNUMBER(SEARCH("X",'Final Insp.'!A11)),"P", "")
B12B12=IF(ISNUMBER(SEARCH("X",'Final Insp.'!A68)),"P", "")
H10H10=IF(ISNUMBER(SEARCH("X",'Final Insp.'!A10)),"P", "")
H11H11=IF(ISNUMBER(SEARCH("",'Final Insp.'!A28)),"P", "")
H12H12=IF(ISNUMBER(SEARCH("",'Final Insp.'!A28)),"P", "")
N10N10=IF(ISNUMBER(SEARCH("",'Final Insp.'!A28)),"P", "")
N11N11=IF(ISNUMBER(SEARCH("",'Final Insp.'!A28)),"P", "")
N12N12=IF(ISNUMBER(SEARCH("X",'Final Insp.'!A52)),"P", "")
V10V10=IF(ISNUMBER(SEARCH("",'Final Insp.'!A53)),"P", "")
V11V11=IF(ISNUMBER(SEARCH("",'Final Insp.'!A53)),"P", "")
V12V12=IF(ISNUMBER(SEARCH("",'Final Insp.'!A53)),"P", "")
AA10AA10=IF(ISNUMBER(SEARCH("",'Final Insp.'!A53)),"P", "")
AA11AA11=IF(ISNUMBER(SEARCH("",'Final Insp.'!A53)),"P", "")
AA12AA12=IF(ISNUMBER(SEARCH("",'Final Insp.'!A53)),"P", "")
K16K16='Final Insp.'!F35
K17K17='Final Insp.'!F42
K18:K20,K22K18='Final Insp.'!D37
Q18:Q21Q18='Final Insp.'!E37
H29H29='Final Insp.'!D36
L29L29='Final Insp.'!E36
P29P29='Final Insp.'!F36
T29T29='Final Insp.'!D47
X29X29='Final Insp.'!F48
AB29AB29='Final Insp.'!E46
G34:G35G34='Final Insp.'!D25
M34:M35M34='Final Insp.'!I25
W34W34='Final Insp.'!E24
W35W35='Final Insp.'!E26
W36W36='Final Insp.'!E25
AC34AC34='Final Insp.'!J24
AC35AC35='Final Insp.'!J26
AC36AC36='Final Insp.'!J25
A41A41="At Elkins Earthworks we appreciate your business. We strive for a standard 10 working day turn arround on all calibrations and repairs from the time we have received your instrument. Your instrument has been serviced in " & NETWORKDAYS('Customer Info'!B14,C8,'Drop Down lists'!M2:M105)-1 & " days. We hope you appreciate our dedication to service and quality."
Cells with Conditional Formatting
CellConditionCell FormatStop If True
AA10:AA12Expression=RIGHT(UPPER('Customer Info'!$B$15),1)="D"textNO
T28:AE29Expression=RIGHT(UPPER('Customer Info'!$B$15),1)="D"textNO
T28:AE28Expression=RIGHT(UPPER('Customer Info'!$B$15),1)="D"textNO
AA10:AE12,T28:AE29Expression=RIGHT(UPPER('Customer Info'!$B$15),1)="D"textNO
I39Cellcontains a blank value textNO
C8Cellcontains a blank value textNO
Cells with Data Validation
CellAllowCriteria
I39:Z39List='Drop Down lists'!$A$1:$A$6
 
Sort by date Sort by votes
mumps said:
Try removing the dots to the left of “Range”.
Click to expand...
I had originally added a .value to the end of my K8 cell, do you know if there's any way to forcibly format it to a way the filename can take?
 
Upvote 0

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
First of all, we have to establish exactly what you want to do. Since your files are located in various folders, do you want to be prompted to select the file you want to process? Do you want to save the PDF version to this folder path: "Z:\Shared\EEW\Lab\Compilation Documents\Envision\" ? Do you want to always print the Sheet "Cal Form"?
 
Upvote 0
mumps said:
First of all, we have to establish exactly what you want to do. Since your files are located in various folders, do you want to be prompted to select the file you want to process? Do you want to save the PDF version to this folder path: "Z:\Shared\EEW\Lab\Compilation Documents\Envision\" ? Do you want to always print the Sheet "Cal Form"?
Click to expand...
Because I have a lot of files and some of them are repairs and not calibrations, I think it'll be simpler to not run it on everything, I'll explain better what I think I need.

  • I want it to always print the sheet "Cal Form"
  • When trying to grab a ton of certificates, I'll just copy paste the required excel sheets into the "C:\Test" folder and run the macro. I can always rename the folder later.
  • I want the PDF copies to be saved to "Z:\Shared\EEW\Lab\Cal Cert PDF"
  • I would like the file name to come out looking like "Date Serial#.pdf" example "10-29-24 1901201B.pdf" Pulled from C8 and K8 as before.
 
Upvote 0
Try:
VBA Code: 
Sub exportToPDF()
    Application.ScreenUpdating = False
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Const strPath As String = "C:\Test\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        Sheets("Cal Form").PrintOut
        With wkbSource.ActiveSheet
                .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                "Z:\Shared\EEW\Lab\Cal Cert PDF\" & Replace(.Range("C8"), "/", "-") & " " & .Range("K8"), _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
                :=False, OpenAfterPublish:=False
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
Please note that the code will replace the "/" with "-" in the date used in the file name.
 
Upvote 0
mumps said:
Try:
VBA Code: 
Sub exportToPDF()
    Application.ScreenUpdating = False
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Const strPath As String = "C:\Test\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        Sheets("Cal Form").PrintOut
        With wkbSource.ActiveSheet
                .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                "Z:\Shared\EEW\Lab\Cal Cert PDF\" & Replace(.Range("C8"), "/", "-") & " " & .Range("K8"), _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
                :=False, OpenAfterPublish:=False
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
Please note that the code will replace the "/" with "-" in the date used in the file name.
Click to expand...

Doesn't seem to work. I replaced the [strExtension = Dir(strPath & "*.xlsx")] line with [strExtension = Dir(strPath & "*.xlsm")] just for the file type change, but what ends up happening is it prompts me to enter a file name for the first one, which will save after I name it, but then it gives an error and fails for the remaining.

1730231220269.png



I also tried changing the naming code to a way I got it working on an individual file basis earlier, but that didn't change anything. See below for that if you want to see how I got rid of the / in the date.

VBA Code: 
Sub exportMANYtoPDF()

Dim DVALUE As String
DVALUE = WorksheetFunction.Text(Range("C8"), "MM-DD-YYYY")

    Application.ScreenUpdating = False
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Const strPath As String = "C:\Test\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsm")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        Sheets("Cal Form").PrintOut
        With wkbSource.ActiveSheet
                .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                "Z:\Shared\EEW\Lab\Cal Cert PDF\" & Range("K8").Value & " " & DVALUE, _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
                :=False, OpenAfterPublish:=False
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

Just these two parts here
VBA Code: 
Dim DVALUE As String
DVALUE = WorksheetFunction.Text(Range("C8"), "MM-DD-YYYY")

                .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                "Z:\Shared\EEW\Lab\Cal Cert PDF\" & Range("K8").Value & " " & DVALUE, _
 
Upvote 0
Can you could upload a copy of your file (de-sensitized if necessary) to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.
 
Upvote 0
mumps said:
Can you could upload a copy of your file (de-sensitized if necessary) to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.
Click to expand...
Is a direct link to my server okay? If you'd prefer I upload them to dropbox or box I'll sign up for one and do that.

6CR 4-9-2024 2002213B - 7221.xlsm
elkins.egnyte.com

6CR 4-9-2024 2002213B - 7221.xlsm on Egnyte

File 6CR 4-9-2024 2002213B - 7221.xlsm shared using Egnyte
elkins.egnyte.com elkins.egnyte.com

7CR 7-18-2024 2002213B - 7617.xlsm
elkins.egnyte.com

7CR 7-18-2024 2002213B - 7617.xlsm on Egnyte

File 7CR 7-18-2024 2002213B - 7617.xlsm shared using Egnyte
elkins.egnyte.com elkins.egnyte.com
 
Upvote 0
I saved the two files you posted in "C:\Test\". Place the macro below in a regular module in a blank workbook and run it from there and the two PDF files will be created.
VBA Code: 
Sub exportToPDF()
    Application.ScreenUpdating = False
    Dim wkbSource As Workbook
    Const strPath As String = "C:\Test\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsm")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        Sheets("Cal Form").PrintOut
        With wkbSource.ActiveSheet
            .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            "Z:\Shared\EEW\Lab\Cal Cert PDF\" & Replace(.Range("C8"), "/", "-") & " " & .Range("K8"), _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
            :=False, OpenAfterPublish:=False
        End With
        wkbSource.Close False
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
Solution
mumps said:
I saved the two files you posted in "C:\Test\". Place the macro below in a regular module in a blank workbook and run it from there and the two PDF files will be created.
VBA Code: 
Sub exportToPDF()
    Application.ScreenUpdating = False
    Dim wkbSource As Workbook
    Const strPath As String = "C:\Test\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsm")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        Sheets("Cal Form").PrintOut
        With wkbSource.ActiveSheet
            .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            "Z:\Shared\EEW\Lab\Cal Cert PDF\" & Replace(.Range("C8"), "/", "-") & " " & .Range("K8"), _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
            :=False, OpenAfterPublish:=False
        End With
        wkbSource.Close False
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
Click to expand...
So it still seems to be having issues on my end. It opens the test documents, and attempts to save them as a PDF but just opens a Save As window and prompts me to name them individually. It also prompts me to update links before it runs as seen below. I've tried both options and it ends with the same result.
1730308848291.png

I did just realize it is actually making the PDF's still if I cancel the Save As window.
 
Upvote 0
I don't get the Save As window so I can't reproduce that problem. You have a link to another file in each of the two workbooks. In the Data menu at the top, click on Workbook Links, break the link and save the file and close it. You have to do this for each file. Then try the macro again.
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question Question
One or more Modules for each sub
Replies
0
Views
827
CrashOD
C
Cliffork
  • Solved
Hiding rows based on the value of data in a column
2
Replies
16
Views
1K
Fluff
Fluff
Oakie_Uffda
  • Question Question
Split Cell into multiple without splitting words and print decent
Replies
1
Views
1K
Oakie_Uffda
Oakie_Uffda
E
  • Question Question
Formula to populate cells that only meet certain criteria from two tables on another sheet
Replies
1
Views
2K
ebj5883
E
G
  • Question Question
Macro Print Setup - To condense lengthy prep steps.
Replies
3
Views
1K
Smitty
Smitty

Forum statistics

Threads
1,224,813
Messages
6,181,109
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top