Printing as PDF

[akram-5]

I am trying to Make a macro and create a button which will Print as PDF and save it in a certain Folder( for this workbook) named as the Text Written in a Certain Cell.
** folder (V:\Payment Vouchers\Riyan\2012\MVR\)
** Workbook Name (RPV_MVR_2012_09)
** WorkSheet named ( Voucher(5) )
** Range J6

The problem here is that i cannot fix the path or i cannot name it according to the text in cell

This macro shows the closest i got.

Please help me

Sub Create_PDF()

' Save_As_PDF

Dim SDrive As String
Dim SSheetName As String
Dim SaveLocation As String
Dim SFilename As String
Dim rspCreate


SDrive = "V:\"
'SaveLocation = Sheets("Sheet1").Range("F1").Value
SaveLocation = SDrive & ActiveWorkbook.Worksheets(1).Name

'when run it creates a folder named as sheet name.

'only C drive can be used, or else folder is created but PDF file not saved in the folder.

'the code uses the file name and makes it the PDF name, i want code to use the vale in J6 as file name for PDF created.

'the drive(the first run created it)

If Dir(SaveLocation, vbDirectory) = "" Then
    rspCreate = MsgBox("Directory doesn't exist, do you wish to create it?", vbYesNo)
     
    If rspCreate = vbYes Then
        MkDir (SaveLocation)
        SFilename = SaveLocation & "\" & Sheets("Sheet1").Range("J6").Value
    End If
End If

ChDir (SaveLocation)
' Set the Print Area

ActiveSheet.PageSetup.PrintArea = "A1:M36"


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

End Sub

 

[akram-5]

the code works in xl 2010

 

[Mohammad Basem]

There is one potential source of problem if the target folder already exists.

Try moving the SFilename statement outside the nested Ifs block,

[FONT="Consolas"][SIZE="2"][COLOR="Navy"]If Dir(SaveLocation, vbDirectory) = "" Then
    rspCreate = MsgBox("Directory doesn't exist, do you wish to create it?", vbYesNo)
     
    If rspCreate = vbYes Then
        MkDir (SaveLocation)
    End If
End If
SFilename = SaveLocation & "\" & Sheets("Sheet1").Range("J6").Value[/COLOR][/SIZE][/FONT]

 

[akram-5]

i did it and it worked. if no file name is given macro stops. so i amended it. Thank you for your help

 

[Mohammad Basem]

Al-hamdullah, thank you for the feedback!