VBA (also non vba) Help Required - Saving To PDF

[The Great SrH]

Hi all,

I have a "macro-enabled" excel document i've created. I'm looking to add the following code to save part as the document as PDF.

Private Sub CommandButton4_Click()
Application.ScreenUpdating = False
Worksheets("request").Unprotect ("bacon")
    Sheets("request").Range("A1:I45").ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=Range("S8").Value _
    , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
    :=False, OpenAfterPublish:=True
            
Worksheets("request").Protect ("bacon")
Application.ScreenUpdating = True

End Sub

I want the document to save in the same location as the Excel file. An alternative code I'd like if anyone has, is for the user to have the "Save As" box appear so they can name the file themselves.

However, I keep getting a runtime error stating:
"Run-Time Error '1004' Document not saved. The document may be open or an error may have been encountered."

When i try to export the document as PDF (non VBA), I also get a similar error.

Any suggestions on how to fix this?
Thanks

 

[The Great SrH]

Hi, yes this one works fine in a brand new workbook.

 

[Yongle]

Let's now get it working in the original workbook - copy the same macro into a standard module in the original workbook ,amend the file name and run it

Dim fname As String: fname = "YongleTest[COLOR=#ff0000]2[/COLOR]"

Does it run correctly?
NO: If it does not run, then the quickest solution would be to create a new workbook and not try to fix the original.

YES: If it does, then you should be able to amend the macro one line at a time and test each change until it fails

1. amend

Dim fname As String: fname = Sheets("NameOfSheet").Range("S8").Value

TEST

2. amend

Dim fpath As String: fpath = ActiveWorkbook.Path

TEST

etc

 

[The Great SrH]

Let's now get it working in the original workbook - copy the same macro into a standard module in the original workbook ,amend the file name and run it

Dim fname As String: fname = "YongleTest[COLOR=#ff0000]2[/COLOR]"

Does it run correctly?
NO: If it does not run, then the quickest solution would be to create a new workbook and not try to fix the original.

YES: If it does, then you should be able to amend the macro one line at a time and test each change until it fails

1. amend

Dim fname As String: fname = Sheets("NameOfSheet").Range("S8").Value

TEST

2. amend

Dim fpath As String: fpath = ActiveWorkbook.Path

TEST

etc

Unfortunately it still doesn't work - I'll try to re-create in a new workbook. It wouldn't be because I've got a Print Area Named Range would it? Or due to some of the other code in the document?

In preparation to it hopefully working in a new workbook, could you help provide me a code so that the user chooses the document name and location via the usual pop up box?

 

[Yongle]

If you used the macro per post#10 and it still does not work, then that workbook is somehow blocking all ExportToPDF - perhaps the workbook has a minor corruption

could you help provide me a code so that the user chooses the document name and location via the usual pop up box?

- code includes function to eliminate illegal characters from file name

I suggest you test this in a new workbook before modifying it to suit your needs

Sub TestExportToPDF()
    Dim fPath As String:        fPath = GetFolder
    Dim fName As String:        fName = GetName
    Dim fullPath As String:     fullPath = fPath & "\" & fName
    
    ActiveSheet.Range("A1:I45").ExportAsFixedFormat Type:=xlTypePDF, Filename:=fullPath
    MsgBox fullPath & ".pdf"
End Sub

Private Function GetFolder() As String
    Dim chosen As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = ""
        If .Show <> -1 Then GoTo TheEnd
        chosen = .SelectedItems(1)
    End With
TheEnd:
    GetFolder = chosen
End Function

Private Function GetName()
    Dim n As String
UserInput:
    n = InputBox("Enter name for pdf", "Name?", "Name??")
    If n = vbNullString Then GoTo UserInput
    GetName = ReplaceIllegalChar(n)
End Function

Private Function ReplaceIllegalChar(myString As String) As String
    Dim j As Integer, n As String
        For j = 1 To Len(myString)
           Select Case Asc(Mid(myString, j, 1))
                Case 48 To 57, 65 To 90, 97 To 122
                n = n & Mid(myString, j, 1)
           Case Else
                n = n & "_"
           End Select
        Next
    ReplaceIllegalChar = n
End Function

 

[The Great SrH]

If you used the macro per post#10 and it still does not work, then that workbook is somehow blocking all ExportToPDF - perhaps the workbook has a minor corruption


- code includes function to eliminate illegal characters from file name

I suggest you test this in a new workbook before modifying it to suit your needs

Sub TestExportToPDF()
    Dim fPath As String:        fPath = GetFolder
    Dim fName As String:        fName = GetName
    Dim fullPath As String:     fullPath = fPath & "\" & fName
    
    ActiveSheet.Range("A1:I45").ExportAsFixedFormat Type:=xlTypePDF, Filename:=fullPath
    MsgBox fullPath & ".pdf"
End Sub

Private Function GetFolder() As String
    Dim chosen As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = ""
        If .Show <> -1 Then GoTo TheEnd
        chosen = .SelectedItems(1)
    End With
TheEnd:
    GetFolder = chosen
End Function

Private Function GetName()
    Dim n As String
UserInput:
    n = InputBox("Enter name for pdf", "Name?", "Name??")
    If n = vbNullString Then GoTo UserInput
    GetName = ReplaceIllegalChar(n)
End Function

Private Function ReplaceIllegalChar(myString As String) As String
    Dim j As Integer, n As String
        For j = 1 To Len(myString)
           Select Case Asc(Mid(myString, j, 1))
                Case 48 To 57, 65 To 90, 97 To 122
                n = n & Mid(myString, j, 1)
           Case Else
                n = n & "_"
           End Select
        Next
    ReplaceIllegalChar = n
End Function

I rebuilt the entire document and i'm back to getting the same issue with saving to PDF (even with your new code).

 

[Yongle]

So now you know it is something you have added that is causing the problem

1. Run the simple code I provided in post#10 against the sheet you want to export to pdf
- if that works then the problem is in your code
- If that does not work.....add a new sheet in the same workbook and point post#10 code at that sheet - if that works then it is something in your sheet

let me know hpw you get on and also which version of Excel are you running?

 

[The Great SrH]

So now you know it is something you have added that is causing the problem

1. Run the simple code I provided in post#10 against the sheet you want to export to pdf
- if that works then the problem is in your code
- If that does not work.....add a new sheet in the same workbook and point post#10 code at that sheet - if that works then it is something in your sheet

let me know hpw you get on and also which version of Excel are you running?

None of the above worked
I'm using Excel 2016

 

[Yongle]

1 Have you copied something bad from the old workbook to the new workbook? You created your new workbook very quickly
- how did you create it?
- how were sheets created?
- how was data added?
- how was code added?

2 Are you using Power Query?

3. Also try saving manually the document as an XPS Document (similar to pdf) and then open that document
(it is one of the options under SaveAs)

4. It is also possible to Print to PDF (under Print menu, change printer to the PDF option) - try it