PDA

View Full Version : [SOLVED] Save as pdf's



Boris Smits
09-25-2019, 12:53 AM
Hello, I'm looking for a VBA code that does the folowing:

Sheet 1, Sheet 2, Sheet 3 are visible. Each sheet must be saved as a seperate PDF file and the name for the file is mentioned in Cell A1 in every sheet, but is different in every sheet. So in Sheet 1 Cell A1 the file name can be different then in sheet 2 and 3.

The visible sheets are not ALWAYS Sheet 1, 2 and 3. But can also be 2, 7 and 8. But the filename will always be in Ceel A1 in every sheet.

Can somebody help me out?

Thank you!

gmayor
09-25-2019, 02:01 AM
If there are only three sheets visible, the following should work


Sub SaveSheetsAsPDF()Dim xlBook As Workbook
Dim xlSheet As Worksheet
Dim sName As String
Dim i As Integer
Const sPath As String = "C:\Path\" 'the path to save the PDFs


On Error Resume Next
Set xlBook = ActiveWorkbook
Application.DisplayAlerts = False
For i = 1 To xlBook.Sheets.Count
Set xlSheet = xlBook.Sheets(i)
If xlSheet.Visible = xlSheetVisible Then
sName = xlSheet.Cells(1, 1)
If Not Right(LCase(sName), 4) = ".pdf" Then
sName = sName & ".pdf"
End If
sName = FileNameUnique(sPath, sName, "pdf")
xlSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=sPath & sName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End If
Next i
lbl_Exit:
Set xlBook = Nothing
Set xlSheet = Nothing
Exit Sub
End Sub


Private Function FileNameUnique(strPath As String, _
strFileName As String, _
strExtension As String) As String
'Graham Mayor - http://www.gmayor.com - Last updated - 22 Jun 2018
'strPath is the path in which the file is to be saved
'strFilename is the filename to check
'strextension is the extension of the filename to check
Dim lng_F As Long
Dim lng_Name As Long
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
strExtension = Replace(strExtension, Chr(46), "")
lng_F = 1
lng_Name = Len(strFileName) - (Len(strExtension) + 1)
strFileName = Left(strFileName, lng_Name)
'If the filename exists, add or increment a number to the filename
'and keep checking until a unique name is found
Do While FSO.FileExists(strPath & strFileName & Chr(46) & strExtension) = True
strFileName = Left(strFileName, lng_Name) & "(" & lng_F & ")"
lng_F = lng_F + 1
Loop
'Reassemble the filename
FileNameUnique = strFileName & Chr(46) & strExtension
lbl_Exit:
Set FSO = Nothing
Exit Function
End Function

snb
09-25-2019, 02:08 AM
This is all you need


Sub M_snb()
for each it in sheets
if it.visible then it.ExportAsFixedFormat 0,it.cells(1) & ".pdf"
next
End Sub

gmayor
09-25-2019, 03:48 AM
The trouble with such pared back code, that you are so fond of, is that it makes too many assumptions about matters that are not known from the question, such as what is actually in the naming cell, where the files are to be saved and how to deal with filenames that already exist.

snb
09-25-2019, 03:59 AM
The code takes into account all elements that are part of the question: no more, no less.
You should learn to abstain from redundant recorded VBA-code and you should also get acquainted with the concept 'default'.

Boris Smits
09-25-2019, 04:43 AM
As I'm not (at all) an VBA expert.....how does Excel know that the Value is in A1 in your code?

snb
09-25-2019, 05:28 AM
it.cells(1) = Range("A1")

check with


msgbox it.cells(1).address

gmayor
09-25-2019, 05:31 AM
The code takes into account all elements that are part of the question: no more, no less.
You should learn to abstain from redundant recorded VBA-code and you should also get acquainted with the concept 'default'.Perhaps you should get more acquainted with users, particularly inexperienced ones, as Boris's follow up question all too clearly demonstrates.

Boris - the code in snb's example picks the cell A1 as it.cells(1)

Boris Smits
09-25-2019, 08:25 AM
Hello, thanks for the help, but its not working. Sometimes it can be 2 sheets, sometimes 3 or 4. And the path for saving de .pdf files to = I:\ADMINISTRATIE\CONTRACTEN\AANGEMAAKTE ARBEIDSOVK".

And what if the value must be derived from C8 in stead of A1?

Can somebody help me out?

Thanl you!

snb
09-25-2019, 08:50 AM
Of course it is working.

Upload your file.

If C8 contains the filename:


Sub M_snb()
for each it in sheets
if it.visible then it.ExportAsFixedFormat 0,"I:\ADMINISTRATIE\CONTRACTEN\AANGEMAAKTE ARBEIDSOVK\" & it.cells(8,3) & ".pdf"
next
End Sub

austenr
09-25-2019, 10:00 AM
FWIW: bad practice to hard code a file path. What if you need to move it?



Dim strFile As String
strFile=Application.GetOpenFilename(FileFilter:="Excel files *.xlsx* (*.xlsx*)",Title:="Choose an Excel file to open")

Boris Smits
09-25-2019, 01:21 PM
Indeed it is! Thanks very much snb!

snb
09-25-2019, 01:58 PM
Unnecessarily asking for user input is bad practice in my opinion.

snb
09-25-2019, 02:03 PM
@Boris

Mooi zo. Weet je nu ook wat je fout deed ?

gmayor
09-25-2019, 10:13 PM
Hello, thanks for the help, but its not working. Sometimes it can be 2 sheets, sometimes 3 or 4. And the path for saving de .pdf files to = I:\ADMINISTRATIE\CONTRACTEN\AANGEMAAKTE ARBEIDSOVK".

And what if the value must be derived from C8 in stead of A1?

Can somebody help me out?

Thanl you!The path is missing its final separator - I:\ADMINISTRATIE\CONTRACTEN\AANGEMAAKTE ARBEIDSOVK\

The cell C8 can be set at sName = xlSheet.Cells(8, 3) or sName = xlSheet.Range("C8")

If the name can be in either A1 or C8 then you are going to have to be more specific.

snb
09-26-2019, 05:46 AM
Please use F5 before posting.