VBA Save As get directory from cell

[lukestkd]

I have the following code on a macro, which saves sets the print area, saves as PDF and sets the filename to the value in F4.

Sub mcr_saveaspdf()
Dim LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
ActiveSheet.PageSetup.PrintArea = "A1:E" & LR
namefile = Range("F4").Value
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=namefile
End Sub

That is working perfectly, but I need I need to create three more macro buttons to make it useful for our school, this also needs to use the code above to set print area and filename.


1 - Save a PDF copy to a destination where the last section = J2
(e.g. F:\RMSharedDocs\LPo\J2) - J2 would be "10lIt1\StudentName"
AND
Save an excel copy to a destination where the last section is the name as above, but the other part would be (N:\Documents\Feedback\J2)


2 - Save a PDF copy to a destination where last section is as above, but the first section is in J1. (e.g. "J1""F4") - (C:\Documents and Settings\lukepollard\Desktop\Feedback\10lIt1\StudentName)


3 - Launch SaveAs dialog and set file type to macro enabled workbook


Apologies to bombard - any advice would be greatly appreciated


Luke

FILE ATTACHED: feedbackversionforExcelForum.xlsm

[tigeravatar]

lukestkd,

What is actually in F4 and J2? From your code, it looks like F4 is a complete file path and J2 is only a partial file path. Is that always the case? Is that the same for F1 and F2?

Also, to use the saveas dialog box with .xlsm file extensions:

Sub tgr_SaveAs_xlsm()
    
    Dim strSave As String
    Dim strExt As String
    
    With ActiveWorkbook
        strExt = Mid(.Name, InStrRev(.Name, "."))
        strSave = Application.GetSaveAsFilename(Replace(.Name, strExt, ".xlsm"), "Excel Macro Enabled Workbook, *.xlsm")
        If strSave = "False" Then Exit Sub  'Pressed cancel
        .SaveAs strSave, xlOpenXMLWorkbookMacroEnabled
    End With
    
End Sub

[lukestkd]

Hi Tiger,
I've attached the wb in my original post. My original explanation was poor! J2 is a concatenate of A4 and B4, I've realised I could do another concatenate to form the directories required - I have done this. So what I need in actual fact is:

1) Save two files from one button, one macro wb in location (K10), one pdf file in location (K11) - both where filename is (F4)
2) Save one file as macro wb in location (K12) - filename is (F4)
3) Save as dialog where file type is macro wb and filename is (F4)

Hope that makes what I need more clear. Thank you very much for your input! Luke

[tigeravatar]

Luke,

Attached is a modified version of your posted workbook.

The green shape has had its text changed to "Save both pdf and xlsm"
It has been assigned to the following macro:

Sub tgr_SaveBoth_PDF_and_XLSM()
    
    Call SaveFile(Range("K10").Text & Range("F4").Text & ".xlsm", ActiveSheet)
    Call SaveFile(Range("K11").Text & Range("F4").Text & ".pdf", ActiveSheet)
    
End Sub

The orange shape has had its text changed to "Save xlsm"
It has been assigned to the following macro:

Sub tgr_SaveXLSM()
    
    Call SaveFile(Range("K12").Text & Range("F4").Text & ".xlsm", ActiveSheet)
    
End Sub

The black shape has had its text changed to "Save as dialog"
It has been assigned to the following macro:

Sub tgr_SaveAs_xlsm()
    
    Dim strSave As String
    
    strSave = Application.GetSaveAsFilename(Range("F4").Text, "Excel Macro Enabled Workbook, *.xlsm")
    If strSave = "False" Then Exit Sub  'Pressed cancel
    Call SaveFile(strSave, .ActiveSheet)
    
End Sub

All three of those macros call the following macro named SaveFile:

Public Sub SaveFile(ByVal strFullPath As String, ByRef ws As Worksheet)
    
    Dim strExt As String
    
    strExt = Mid(strFullPath, InStrRev(strFullPath, "."))
    
    On Error GoTo CleanExit
    Select Case strExt
        Case ".xlsm": ActiveWorkbook.SaveAs strFullPath, xlOpenXMLWorkbookMacroEnabled
        Case ".pdf":  ws.ExportAsFixedFormat xlTypePDF, strFullPath
        Case Else:    MsgBox "Invalid File format." & vbCrLf & "Must be .xlsm or .pdf", , "Invalid Format"
    End Select
    Exit Sub
    
CleanExit:
    MsgBox "Save operation failed" & vbCrLf & "File path not found: " & Left(strFullPath, InStrRev(strFullPath, Application.PathSeparator)), , "Save Error"
    Err.Clear
    
End Sub

[lukestkd]

Tiger,
They are absolutely amazing and will save literally hours over the year with the number of students and feedback given each week!

The only error I am getting is on tgr_SaveAs_xlsm(),

on the line

Call SaveFile(strSave, .ActiveSheet)

[tigeravatar]

Oh, that's because I forgot to remove the period in in front of ActiveSheet
Just delete that period and it should be fine.

[lukestkd]

TIGER!! That is phenomenal. I am in awe. If you find yourself in Leeds one day a pint is on me! I can't test the save as .xlsm and .pdf until school re-opens the week after next, but I will get back to you to confirm that side of things is working correctly then.

Am I right in thinking that if I wanted to copy the save xlsm code and edited is as follows it would instant save a .pdf?

Sub tgr_SaveXLSM()
    
    Call SaveFile(Range("K12").Text & Range("F4").Text & ".pdf", ActiveSheet)
    
End Sub

[tigeravatar]

You're very welcome And yes, that is correct