ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Code to save spreadsheet (https://www.excelbanter.com/excel-programming/334403-code-save-spreadsheet.html)

FrigidDigit

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




ben

Code to save spreadsheet
 
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





Tom Ogilvy

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






STEVE BELL

Code to save spreadsheet
 
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" 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






FrigidDigit

Code to save spreadsheet (Thanks ben, Tom Ogilvy,Steve Bell))
 
Appreciate the help!




All times are GMT +1. The time now is 11:42 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com