View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Tom Ogilvy Tom Ogilvy is offline
external usenet poster
 
Posts: 27,285
Default Code to save spreadsheet

If you only want to allow the user to pick a folder, then put up the folder
select dialog.

http://j-walk.com/ss/excel/tips/tip29.htm
at John Walkenbach's site

--
Regards,
Tom Ogilvy

"FrigidDigit" wrote in message
...
Hi Everyone!

I have a spreadsheet for which I have used code (see below) to determine a
filename to be used when saving the template based on certain cell values.
I have added code to check whether the user has changed the save as name
which appears in the dialog box. All works fine except if the user wants

to
save the file in a folder other than the one in which the template resides
in. How can I allow the user to change the directory in which to save
without changing the filename?

Any help is much appreciated!

Regards

Lawrence.



Public Sub SaveInvoice()
Dim SaveName As String
Dim SaveDir As String
Dim SaveMonthStart As String
Dim SaveMonthEnd As String
Dim SaveYearStart As String
Dim SaveYearEnd As String
Dim FixedInvNum As String

SaveMonthStart = Worksheets("Billing Rates").Range("AE11").Value
SaveMonthEnd = Worksheets("Billing Rates").Range("AF11").Value
SaveYearStart = Worksheets("Billing Rates").Range("AG11").Value
SaveYearEnd = Worksheets("Billing Rates").Range("AH11").Value

Application.ScreenUpdating = False
VerifyInvoice
Application.ScreenUpdating = True
If Worksheets("Inv Summ").Range("I12").Value < 10 Then
FixedInvNum = "0" & Worksheets("Inv Summ").Range("I12").Value
Else: FixedInvNum = Worksheets("Inv Summ").Range("I12").Value
End If

If SaveYearStart = SaveYearEnd And SaveMonthStart = SaveMonthEnd Then
SaveName = Worksheets("Billing Rates").Range("AB11").Value & " - IEP
Inv#" & FixedInvNum & _
" TO" & Range("I11").Value & " " & SaveMonthEnd & " " & SaveYearEnd &
".xls"
Else
SaveName = Worksheets("Billing Rates").Range("AB11").Value & " - IEP
Inv#" & FixedInvNum _
& " TO" & Range("I11").Value & " " & SaveMonthStart & " " &
SaveYearStart & " - " & _
SaveMonthEnd & " " & SaveYearEnd & ".xls"

End If
SaveName = ActiveWorkbook.Path & "\" & SaveName
Restart:
filesavename = Application.GetSaveAsFilename( _
InitialFileName:=SaveName, fileFilter:="Excel Files (*.xls), *.xls")

If filesavename = False Then
Exit Sub
ElseIf filesavename < SaveName Then
MsgBox "Please do not change the generated file name when saving."
MsgBox "Filesavename = " & filesavename & Chr(13) & "SaveName = " &
SaveName
'MsgBox ActiveWorkbook.Path
GoTo Restart
End If
ActiveWorkbook.SaveAs Filename:=filesavename
End Sub