Open Dialogue box and save as pdf with fname=cellvalue

[Pioneer]

Hello,

I am new VB. I would highly appreciate if someone can help me out.

I want to open a save as dialogue box with a file name = cell value and save the file in pdf.
I have written the code and it working.
Here is the problem - the file gets saved when i click the "save" and "cancel" button in the save as dialogue box.
When i click save - there is no pop up screen to indicate a pdf has been saved. The pdf opens when i close the save as window.
When i clink the cancel botton - a pdf get saved and opens.

Also the file name does not appears on the save as filename box while saving the file.

the macros is:

Sub SavePDF1()
'
'turn off screen updating
Dim Opendialog
'
'open dialog and set file type
    Opendialog = Application.GetSaveAsFilename("", FileFilter:="PDF Files (*.pdf), *.pdf", _
                                               Title:="Sheet2!$CI$267")
'
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Range("Sheet2!$CI$267").Value _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
End Sub

 

[Deepak]

Hi,

Welcome @ chandoo awesome forum of excel.

Always tag your code in your post. I did for now!!!

Check this...

This will auto save the current sheet as PDF on location C:\Users\dEEPAK\Desktop\ with name of Sheet2.[A10].Value

Sub SavePDF1()
Dim mystr As String

mystr = "C:\Users\dEEPAK\Desktop\" & Sheet2.[A10].Value & ".pdf"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=mystr _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
End Sub

 

[Pioneer]

Hi,

Welcome @ chandoo awesome forum of excel.

Always tag your code in your post. I did for now!!!

Check this...

This will auto save the current sheet as PDF on location C:\Users\dEEPAK\Desktop\ with name of Sheet2.[A10].Value

Sub SavePDF1()
Dim mystr As String

mystr = "C:\Users\dEEPAK\Desktop\" & Sheet2.[A10].Value & ".pdf"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=mystr _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
End Sub

Thank you for a prompt reply Deepak.

I want the users to choose which folder they want to save the file. Since my form will be used on multiple devices.
Hence i want the save as dialogue box to open with filename=cell value. THe users should choose the folder they want to save and then click save button.

I am not sure if this this is possible, but when the user clicks cancel in the save as dialogue box - an message should be displayed: File not saved.

Thank you for all your help.

 

[Deepak]

Hi,

Pls check this!!

Sub SavePDF1()

Dim Opendialog As Variant

Opendialog = Application.GetSaveAsFilename(Sheet1.[A10].Value, "PDF (*.pdf), *.pdf")

If Not Opendialog <> False Then MsgBox "File not saved.", vbCritical: Exit Sub

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Opendialog _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True

MsgBox "Saved.", vbInformation

End Sub

 

[Pioneer]

Hi,

Pls check this!!

Sub SavePDF1()

Dim Opendialog As Variant

Opendialog = Application.GetSaveAsFilename(Sheet1.[A10].Value, "PDF (*.pdf), *.pdf")

If Not Opendialog <> False Then MsgBox "File not saved.", vbCritical: Exit Sub

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Opendialog _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True

MsgBox "Saved.", vbInformation

End Sub

Thank you so much. This is life saver.
I have one last question. After protecting the worksheet and the workbook, the file is allowing the user to assign different macro to a command button. How can i disallow this to happen.

 

[Pioneer]

Thank you so much. This is life saver.
I have one last question. After protecting the worksheet and the workbook, the file is allowing the user to assign different macro to a command button. How can i disallow this to happen.

I got the solution.

I just unselected edit object while protecting the sheet.

THank you Deepak !!

 

[Pioneer]

Hi,

Pls check this!!

Sub SavePDF1()

Dim Opendialog As Variant

Opendialog = Application.GetSaveAsFilename(Sheet1.[A10].Value, "PDF (*.pdf), *.pdf")

If Not Opendialog <> False Then MsgBox "File not saved.", vbCritical: Exit Sub

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Opendialog _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True

MsgBox "Saved.", vbInformation

End Sub

Oops .. i promise this request will be final:

I want something like this and i almost have the code for this:
There are 4 cells which the user should complete before saving the spreadsheet in pdf. I have the following code which is half working. It gives the intended message, but as the file still gets saved when we clinck the cancel button on the error mesage:

I have following code:

If WorksheetFunction.CountA( _
Worksheets("Sheet1").Range("C3,C4,C5, C6")) < 6 Then
MsgBox "Workbook will not be saved unless" & vbCrLf & _
"All required fields have been filled in!", , "Missing info" vbCritical: Exit Sub
Cancel = True
End If

The complete code is:

Sub SavePDF1()
Dim Opendialog As Variant
If WorksheetFunction.CountA( _
Worksheets("Sheet1").Range("C3,C4,C5, C6")) < 6 Then
MsgBox "Workbook will not be saved unless" & vbCrLf & _
"All required fields have been filled in!", , "Missing info" vbCritical: Exit Sub
Cancel = True
End If

Opendialog = Application.GetSaveAsFilename(Sheet1.[Sheet2!$CI$267].Value & Format(Date, "mmddyyyy"), "PDF (*.pdf), *.pdf")

If Not Opendialog <> False Then MsgBox "File not saved.", vbCritical: Exit Sub

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Opendialog _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True

MsgBox "File Saved.", vbInformation
                                        
End Sub

 

[Deepak]

Hi,

Change this & check as you have wrongly written the msgbox syntex.

If WorksheetFunction.CountA( _
    Worksheets("Sheet1").Range("C3,C4,C5,C6")) < 4 Then
   
    MsgBox "Workbook will not be saved unless" & vbCrLf & "All required fields have been filled in!", vbCritical, "Missing info"
   
    Exit Sub
End If

 

[Pioneer]

Hi,

Change this & check as you have wrongly written the msgbox syntex.

If WorksheetFunction.CountA( _
    Worksheets("Sheet1").Range("C3,C4,C5,C6")) < 4 Then
  
    MsgBox "Workbook will not be saved unless" & vbCrLf & "All required fields have been filled in!", vbCritical, "Missing info"
  
    Exit Sub
End If

You are awesome. It works........ but with defect..
It works when all the 4 cells i.e. C3:C6 are blank...
But.... if C1 (or any other cell) has some value in it and the rest of the cells are empty, i don't get the message to complete the mandatory cells and i am able save the file.

Can this be fixed.

Thanks.

 

[Deepak]

Hi,

What u wriiten to fix is case of CountA which failed to accomplish the assignment. But till the time I never felt the countA doesn't produced the output until or unless correct range are not given.

So, pls recheck with the same & don't forget to check correct sheet & range.

However, You are still in the glitch then share that sample wb here.

We will check the same.

 

[Pioneer]

Hi,

What u wriiten to fix is case of CountA which failed to accomplish the assignment. But till the time I never felt the countA doesn't produced the output until or unless correct range are not given.

So, pls recheck with the same & don't forget to check correct sheet & range.

However, You are still in the glitch then share that sample wb here.

We will check the same.

Thank you for all the help. I did the following to resolve the issue:
If WorksheetFunction.CountA( _
Worksheets("Sheet1").Range("C3")) < 1 Then

MsgBox "Workbook will not be saved unless" & vbCrLf & "All required fields have been filled in!", vbCritical, "Missing info"

ExitSub
EndIf

I wrote this code for each cell. i.e C3, C4,C5 AND C6. I know its a long code but its working.

 

[Deepak]

Hi,

Just retested & found working...

Sub test()
If WorksheetFunction.CountA( _
    Worksheets("Sheet1").Range("C3,C4,C5,C6")) < 4 Then
 
    MsgBox "Workbook will not be saved unless" & vbCrLf & "All required fields have been filled in!", vbCritical, "Missing info"
 
    Exit Sub
End If
End Sub