Code to save spreadsheet

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

look up in help the filedialogs method and see "FolderPicker" dialog
will allow user to choose a folder you can reference but not to change names

--
When you lose your mind, you free your life.


"FrigidDigit" wrote:

> 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
>
>
>
>

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" <[email protected]> wrote in message
news:[email protected]...
> 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
>
>
>

Here's some code I picked up from this ng (works in Excel 2000)
Opens the Save-As dialog.
Amend it to fit your needs...

Sub ShowSaveAsDialog()
Dim v_Filename As Variant
'Variant because the dialog will
'return False if cancelled.

'The Len expression gets rid of the .txt extension.

v_Filename = Application.GetSaveAsFilename _
(initialfilename:=Left(ActiveWorkbook.Name, _
Len(ActiveWorkbook.Name) - 4), _
fileFilter:="Microsoft Excel Workbook (*.xls), *.xls")

If v_Filename = False Then Exit Sub

ActiveWorkbook.SaveAs v_Filename, xlWorkbookNormal

End Sub


--
steveB

Remove "AYN" from email to respond
"FrigidDigit" <[email protected]> wrote in message
news:[email protected]...
> 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
>
>
>

Appreciate the help!