Save as pdf's

[Boris Smits]

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]

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]

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]

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]

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]

As I'm not (at all) an VBA expert.....how does Excel know that the Value is in A1 in your code?

[snb]

it.cells(1) = Range("A1")

check with

msgbox it.cells(1).address

[gmayor]

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]

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]

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]

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]

Indeed it is! Thanks very much snb!

[snb]

Unnecessarily asking for user input is bad practice in my opinion.

[snb]

@Boris

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

[gmayor]

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]

Please use F5 before posting.