| Home |
| Search |
| Today's Posts |
|
|
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Save as
Hi, I have the following macro Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If Target.Address = Range("S2").Address Then If MsgBox("Do you want to rotate shift", vbYesNo + vbInformation, "Galashiels Operational Resources © MN ") < _ vbYes Then Exit Sub Dim lngRow As Long Dim intTemp As Integer Dim arrData(17) As Variant Range("N2") = Range("N2") + 7 Range("D4") = Range("D4") + 7 Range("F4") = Range("F4") + 7 Range("H4") = Range("H4") + 7 Range("J4") = Range("J4") + 7 Range("L4") = Range("L4") + 7 Range("N4") = Range("N4") + 7 Range("P4") = Range("P4") + 7 arrData(0) = Range("C37") For lngRow = 5 To 37 Step 2 intTemp = intTemp + 1 arrData(intTemp) = Range("C" & lngRow) Range("C" & lngRow) = arrData(intTemp - 1) Next Range("C1") = varValue Range("D6:Q6").ClearContents Range("D8:Q8").ClearContents Range("D10:Q10").ClearContents Range("D12:Q12").ClearContents Range("D14:Q14").ClearContents Range("D16:Q16").ClearContents Range("D18:Q18").ClearContents Range("D20:Q20").ClearContents Range("D22:Q22").ClearContents Range("D24:Q24").ClearContents Range("D26:Q26").ClearContents Range("D28:Q28").ClearContents Range("D30:Q30").ClearContents Range("D32:Q32").ClearContents Range("D34:Q34").ClearContents Range("D36:Q36").ClearContents Range("D38:Q38").ClearContents Range("B45:Q45").ClearContents Range("D6:Q6").Interior.ColorIndex = xlNone Range("D8:Q8").Interior.ColorIndex = xlNone Range("D10:Q10").Interior.ColorIndex = xlNone Range("D12:Q12").Interior.ColorIndex = xlNone Range("D14:Q14").Interior.ColorIndex = xlNone Range("D16:Q16").Interior.ColorIndex = xlNone Range("D18:Q18").Interior.ColorIndex = xlNone Range("D20:Q20").Interior.ColorIndex = xlNone Range("D22:Q22").Interior.ColorIndex = xlNone Range("D24:Q24").Interior.ColorIndex = xlNone Range("D26:Q26").Interior.ColorIndex = xlNone Range("D28:Q28").Interior.ColorIndex = xlNone Range("D30:Q30").Interior.ColorIndex = xlNone Range("D32:Q32").Interior.ColorIndex = xlNone Range("D34:Q34").Interior.ColorIndex = xlNone Range("D36:Q36").Interior.ColorIndex = xlNone Range("D38:Q38").Interior.ColorIndex = xlNone Range("B45:Q45").Interior.ColorIndex = xlNone End If End Sub What I am needing to do is when the save icon is pressed or close document I want a pop up message to say: Are you wanting to save as Week Comm 06 July 2009. the only thing is I want the date at the end to relate to a cell N2 as this cell updates with the date of the week commencing. Can any help me with this. Regards Mark |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Save as
From VBE; treeview double click 'This workbook' and paste the below code... Private Sub Workbook_BeforeClose(Cancel As Boolean) If MsgBox("Do you want to save as 'Week Comm " & Range("N2") & _ "'", vbYesNo + vbDefaultButton2 + vbQuestion, "File Save") = vbYes Then 'Do something if answer is yes End If End Sub If this post helps click Yes --------------- Jacob Skaria "terilad" wrote: Hi, I have the following macro Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If Target.Address = Range("S2").Address Then If MsgBox("Do you want to rotate shift", vbYesNo + vbInformation, "Galashiels Operational Resources © MN ") < _ vbYes Then Exit Sub Dim lngRow As Long Dim intTemp As Integer Dim arrData(17) As Variant Range("N2") = Range("N2") + 7 Range("D4") = Range("D4") + 7 Range("F4") = Range("F4") + 7 Range("H4") = Range("H4") + 7 Range("J4") = Range("J4") + 7 Range("L4") = Range("L4") + 7 Range("N4") = Range("N4") + 7 Range("P4") = Range("P4") + 7 arrData(0) = Range("C37") For lngRow = 5 To 37 Step 2 intTemp = intTemp + 1 arrData(intTemp) = Range("C" & lngRow) Range("C" & lngRow) = arrData(intTemp - 1) Next Range("C1") = varValue Range("D6:Q6").ClearContents Range("D8:Q8").ClearContents Range("D10:Q10").ClearContents Range("D12:Q12").ClearContents Range("D14:Q14").ClearContents Range("D16:Q16").ClearContents Range("D18:Q18").ClearContents Range("D20:Q20").ClearContents Range("D22:Q22").ClearContents Range("D24:Q24").ClearContents Range("D26:Q26").ClearContents Range("D28:Q28").ClearContents Range("D30:Q30").ClearContents Range("D32:Q32").ClearContents Range("D34:Q34").ClearContents Range("D36:Q36").ClearContents Range("D38:Q38").ClearContents Range("B45:Q45").ClearContents Range("D6:Q6").Interior.ColorIndex = xlNone Range("D8:Q8").Interior.ColorIndex = xlNone Range("D10:Q10").Interior.ColorIndex = xlNone Range("D12:Q12").Interior.ColorIndex = xlNone Range("D14:Q14").Interior.ColorIndex = xlNone Range("D16:Q16").Interior.ColorIndex = xlNone Range("D18:Q18").Interior.ColorIndex = xlNone Range("D20:Q20").Interior.ColorIndex = xlNone Range("D22:Q22").Interior.ColorIndex = xlNone Range("D24:Q24").Interior.ColorIndex = xlNone Range("D26:Q26").Interior.ColorIndex = xlNone Range("D28:Q28").Interior.ColorIndex = xlNone Range("D30:Q30").Interior.ColorIndex = xlNone Range("D32:Q32").Interior.ColorIndex = xlNone Range("D34:Q34").Interior.ColorIndex = xlNone Range("D36:Q36").Interior.ColorIndex = xlNone Range("D38:Q38").Interior.ColorIndex = xlNone Range("B45:Q45").Interior.ColorIndex = xlNone End If End Sub What I am needing to do is when the save icon is pressed or close document I want a pop up message to say: Are you wanting to save as Week Comm 06 July 2009. the only thing is I want the date at the end to relate to a cell N2 as this cell updates with the date of the week commencing. Can any help me with this. Regards Mark |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Save as
Hi Jacob,
I am looking for a command to put in the code to replace: 'Do something if answer is yes, I want this to save a file as the new name on the desktop, if no is selected I want the workbook to close and make no changes, can you help with this code. Regards Mark "Jacob Skaria" wrote: From VBE; treeview double click 'This workbook' and paste the below code... Private Sub Workbook_BeforeClose(Cancel As Boolean) If MsgBox("Do you want to save as 'Week Comm " & Range("N2") & _ "'", vbYesNo + vbDefaultButton2 + vbQuestion, "File Save") = vbYes Then 'Do something if answer is yes End If End Sub If this post helps click Yes --------------- Jacob Skaria "terilad" wrote: Hi, I have the following macro Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If Target.Address = Range("S2").Address Then If MsgBox("Do you want to rotate shift", vbYesNo + vbInformation, "Galashiels Operational Resources © MN ") < _ vbYes Then Exit Sub Dim lngRow As Long Dim intTemp As Integer Dim arrData(17) As Variant Range("N2") = Range("N2") + 7 Range("D4") = Range("D4") + 7 Range("F4") = Range("F4") + 7 Range("H4") = Range("H4") + 7 Range("J4") = Range("J4") + 7 Range("L4") = Range("L4") + 7 Range("N4") = Range("N4") + 7 Range("P4") = Range("P4") + 7 arrData(0) = Range("C37") For lngRow = 5 To 37 Step 2 intTemp = intTemp + 1 arrData(intTemp) = Range("C" & lngRow) Range("C" & lngRow) = arrData(intTemp - 1) Next Range("C1") = varValue Range("D6:Q6").ClearContents Range("D8:Q8").ClearContents Range("D10:Q10").ClearContents Range("D12:Q12").ClearContents Range("D14:Q14").ClearContents Range("D16:Q16").ClearContents Range("D18:Q18").ClearContents Range("D20:Q20").ClearContents Range("D22:Q22").ClearContents Range("D24:Q24").ClearContents Range("D26:Q26").ClearContents Range("D28:Q28").ClearContents Range("D30:Q30").ClearContents Range("D32:Q32").ClearContents Range("D34:Q34").ClearContents Range("D36:Q36").ClearContents Range("D38:Q38").ClearContents Range("B45:Q45").ClearContents Range("D6:Q6").Interior.ColorIndex = xlNone Range("D8:Q8").Interior.ColorIndex = xlNone Range("D10:Q10").Interior.ColorIndex = xlNone Range("D12:Q12").Interior.ColorIndex = xlNone Range("D14:Q14").Interior.ColorIndex = xlNone Range("D16:Q16").Interior.ColorIndex = xlNone Range("D18:Q18").Interior.ColorIndex = xlNone Range("D20:Q20").Interior.ColorIndex = xlNone Range("D22:Q22").Interior.ColorIndex = xlNone Range("D24:Q24").Interior.ColorIndex = xlNone Range("D26:Q26").Interior.ColorIndex = xlNone Range("D28:Q28").Interior.ColorIndex = xlNone Range("D30:Q30").Interior.ColorIndex = xlNone Range("D32:Q32").Interior.ColorIndex = xlNone Range("D34:Q34").Interior.ColorIndex = xlNone Range("D36:Q36").Interior.ColorIndex = xlNone Range("D38:Q38").Interior.ColorIndex = xlNone Range("B45:Q45").Interior.ColorIndex = xlNone End If End Sub What I am needing to do is when the save icon is pressed or close document I want a pop up message to say: Are you wanting to save as Week Comm 06 July 2009. the only thing is I want the date at the end to relate to a cell N2 as this cell updates with the date of the week commencing. Can any help me with this. Regards Mark |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Save as
Private Sub Workbook_BeforeClose(Cancel As Boolean) Application.EnableEvents = False Application.DisplayAlerts = False If MsgBox("Do you want to save as 'Week Comm " & Range("N2") & _ "'", vbYesNo + vbDefaultButton2 + vbQuestion, "File Save") = vbYes Then ActiveWorkbook.SaveAs Filename:= "Galashiels Resources WC " & Range("N2") ActiveWorkbook.Close Else ActiveWorkbook.Close savechanges:=false End If Application.EnableEvents = True Application.DisplayAlerts = True End Sub If this post helps click Yes --------------- Jacob Skaria "terilad" wrote: Hi Jacob, I am looking for a command to put in the code to replace: 'Do something if answer is yes, I want this to save a file as the new name on the desktop, if no is selected I want the workbook to close and make no changes, can you help with this code. Regards Mark "Jacob Skaria" wrote: From VBE; treeview double click 'This workbook' and paste the below code... Private Sub Workbook_BeforeClose(Cancel As Boolean) If MsgBox("Do you want to save as 'Week Comm " & Range("N2") & _ "'", vbYesNo + vbDefaultButton2 + vbQuestion, "File Save") = vbYes Then 'Do something if answer is yes End If End Sub If this post helps click Yes --------------- Jacob Skaria "terilad" wrote: Hi, I have the following macro Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If Target.Address = Range("S2").Address Then If MsgBox("Do you want to rotate shift", vbYesNo + vbInformation, "Galashiels Operational Resources © MN ") < _ vbYes Then Exit Sub Dim lngRow As Long Dim intTemp As Integer Dim arrData(17) As Variant Range("N2") = Range("N2") + 7 Range("D4") = Range("D4") + 7 Range("F4") = Range("F4") + 7 Range("H4") = Range("H4") + 7 Range("J4") = Range("J4") + 7 Range("L4") = Range("L4") + 7 Range("N4") = Range("N4") + 7 Range("P4") = Range("P4") + 7 arrData(0) = Range("C37") For lngRow = 5 To 37 Step 2 intTemp = intTemp + 1 arrData(intTemp) = Range("C" & lngRow) Range("C" & lngRow) = arrData(intTemp - 1) Next Range("C1") = varValue Range("D6:Q6").ClearContents Range("D8:Q8").ClearContents Range("D10:Q10").ClearContents Range("D12:Q12").ClearContents Range("D14:Q14").ClearContents Range("D16:Q16").ClearContents Range("D18:Q18").ClearContents Range("D20:Q20").ClearContents Range("D22:Q22").ClearContents Range("D24:Q24").ClearContents Range("D26:Q26").ClearContents Range("D28:Q28").ClearContents Range("D30:Q30").ClearContents Range("D32:Q32").ClearContents Range("D34:Q34").ClearContents Range("D36:Q36").ClearContents Range("D38:Q38").ClearContents Range("B45:Q45").ClearContents Range("D6:Q6").Interior.ColorIndex = xlNone Range("D8:Q8").Interior.ColorIndex = xlNone Range("D10:Q10").Interior.ColorIndex = xlNone Range("D12:Q12").Interior.ColorIndex = xlNone Range("D14:Q14").Interior.ColorIndex = xlNone Range("D16:Q16").Interior.ColorIndex = xlNone Range("D18:Q18").Interior.ColorIndex = xlNone Range("D20:Q20").Interior.ColorIndex = xlNone Range("D22:Q22").Interior.ColorIndex = xlNone Range("D24:Q24").Interior.ColorIndex = xlNone Range("D26:Q26").Interior.ColorIndex = xlNone Range("D28:Q28").Interior.ColorIndex = xlNone Range("D30:Q30").Interior.ColorIndex = xlNone Range("D32:Q32").Interior.ColorIndex = xlNone Range("D34:Q34").Interior.ColorIndex = xlNone Range("D36:Q36").Interior.ColorIndex = xlNone Range("D38:Q38").Interior.ColorIndex = xlNone Range("B45:Q45").Interior.ColorIndex = xlNone End If End Sub What I am needing to do is when the save icon is pressed or close document I want a pop up message to say: Are you wanting to save as Week Comm 06 July 2009. the only thing is I want the date at the end to relate to a cell N2 as this cell updates with the date of the week commencing. Can any help me with this. Regards Mark |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Save as
Hello Mark, Firstly a little constructive criticism of your code. This is a Workbook_SheetSelectionChange event and you do not test for the sheet name. This code will run whenever Range S2 is selected on any worksheet and not only when changing the selection on the required sheet. You can either place the code in the module for the specific worksheet and use Private Sub Worksheet_SelectionChange(ByVal Target As Range) or you should have something like this in your code to identify which sheet has the selection change:- If Sh.CodeName < "Sheet1" Then Exit Sub You can get the CodeName from the Project Explorer (Left column of the VBA editor screen.) The Code name is first and the worksheet given name is in parenthesis. If the user changes the given name then the CodeName does not change and is therefore safer to use in the VBA code. Secondly what do you want to do if the user answers No the question Are you wanting to save as Week Comm 06 July 2009? At this point I suggest that you need to allow the user to:- Abort the Save or Close and keep file open. Save as existing file name. Save as a new filename given by the user. Close without saving. Reason to allow Close without saving is that the user might have messed up and wants to start again. For this reason it is dangerous not to allow a user to close without saving. -- Regards, OssieMac |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Save as
Hi OssieMac Thankyou for your constructive critisism, I am new to VBA and only starting to put things together so thanks for the advice on some aspects. Can you help me with a piece of code to put in place of "Do something if answer is yes" Private Sub Workbook_BeforeClose(Cancel As Boolean) If MsgBox("Do you want to save as 'Week Comm " & Range("N2") & _ "'", vbYesNo + vbDefaultButton2 + vbQuestion, "File Save") = vbYes Then 'Do something if answer is yes End If End Sub I am looking for a command to put in the code to replace: 'Do something if answer is yes, I want this to save a file as the new name e.g Resources WC and the range N2 on the desktop, if no is selected I want the workbook to close and make no changes, can you help with this code. Regards Mark "OssieMac" wrote: Hello Mark, Firstly a little constructive criticism of your code. This is a Workbook_SheetSelectionChange event and you do not test for the sheet name. This code will run whenever Range S2 is selected on any worksheet and not only when changing the selection on the required sheet. You can either place the code in the module for the specific worksheet and use Private Sub Worksheet_SelectionChange(ByVal Target As Range) or you should have something like this in your code to identify which sheet has the selection change:- If Sh.CodeName < "Sheet1" Then Exit Sub You can get the CodeName from the Project Explorer (Left column of the VBA editor screen.) The Code name is first and the worksheet given name is in parenthesis. If the user changes the given name then the CodeName does not change and is therefore safer to use in the VBA code. Secondly what do you want to do if the user answers No the question Are you wanting to save as Week Comm 06 July 2009? At this point I suggest that you need to allow the user to:- Abort the Save or Close and keep file open. Save as existing file name. Save as a new filename given by the user. Close without saving. Reason to allow Close without saving is that the user might have messed up and wants to start again. For this reason it is dangerous not to allow a user to close without saving. -- Regards, OssieMac |
|
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Save as
Hello again Mark, Not sure of which version of xl you are using so I have included code to create and save as xl 97-2003 plus code that I have commented out for xl2007 macro enabled workbook. From your earlier post I assumed that N2 contained a date and therefore I have included code to format that date in an acceptable format for a file name because slashes cannot be used in filenames. You might want to think about changing code so the date format is "yyyy-mm-dd" because then your files will then sort in the correct order. If the user answers No to the msgbox and the file has been changed since the last save then the system will return the usual warning message to the user as to whether they want to save the file befor close. I think this is the best way to go because if the user wants to opt out without save they can but if they want to save as the original filename they have that option also. Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim strPath As String Dim strFilename As String Dim userResponse As Variant 'Edit "Sheet1" to match the sheet where N2 is. 'Format date so that it does not have slashes _ because slashes cannot be used in a filenames _ and assign filename to string variable. strFilename = "Week Comm " & _ Format(Sheets("Sheet1").Range("N2"), _ "dd-mm-yyyy") userResponse = MsgBox("Do you want to save as " _ & strFilename, _ vbYesNo + vbDefaultButton2 + vbQuestion, _ "File Save") If userResponse = vbYes Then 'Can use a string to create alternative _ path in lieu of ThisWorkbook.Path strPath = ThisWorkbook.Path 'Concatenate path and filename and save file _ 'Use following code for xl versions 97 - 2003 strFilename = strPath & "\" & strFilename & ".xls" ThisWorkbook.SaveAs Filename:=strFilename, _ FileFormat:=xlNormal, _ CreateBackup:=False 'Use following code for xl2007 macro enabled. 'strFilename = strPath & "\" & strFilename & ".xlsm" 'ThisWorkbook.SaveAs Filename:= strFilename , _ FileFormat:=xlOpenXMLWorkbookMacroEnabled, _ CreateBackup:=False Else 'Else only reuired if alternative code 'required if user answers no End If End Sub -- Regards, OssieMac |
|
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Save as
Hi, I am having trouble trying to put the code together, here is what I have: Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim strPath As String Dim strFilename As String Dim userResponse As Variant strFilename = "Week Comm " & Format(Sheets("Sheet1").Range("N2"), "dd-mm-yyyy") userResponse = MsgBox("Do you want to save as " & strFilename, vbYesNo + vbDefaultButton2 + vbQuestion, "File Save") If userResponse = vbYes Then strPath = ThisWorkbook.Path strFilename = strPath & "\" & strFilename & ".xls" ThisWorkbook.SaveAs Filename:=strFilename, FileFormat:=xlNormal, CreateBackup:=False Else End If End Sub I am getting an out of range error. Can you help me rearrange the code so it works for me, the file path is c:\User\me\Desktop. Kind regards Mark "OssieMac" wrote: Hello again Mark, Not sure of which version of xl you are using so I have included code to create and save as xl 97-2003 plus code that I have commented out for xl2007 macro enabled workbook. From your earlier post I assumed that N2 contained a date and therefore I have included code to format that date in an acceptable format for a file name because slashes cannot be used in filenames. You might want to think about changing code so the date format is "yyyy-mm-dd" because then your files will then sort in the correct order. If the user answers No to the msgbox and the file has been changed since the last save then the system will return the usual warning message to the user as to whether they want to save the file befor close. I think this is the best way to go because if the user wants to opt out without save they can but if they want to save as the original filename they have that option also. Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim strPath As String Dim strFilename As String Dim userResponse As Variant 'Edit "Sheet1" to match the sheet where N2 is. 'Format date so that it does not have slashes _ because slashes cannot be used in a filenames _ and assign filename to string variable. strFilename = "Week Comm " & _ Format(Sheets("Sheet1").Range("N2"), _ "dd-mm-yyyy") userResponse = MsgBox("Do you want to save as " _ & strFilename, _ vbYesNo + vbDefaultButton2 + vbQuestion, _ "File Save") If userResponse = vbYes Then 'Can use a string to create alternative _ path in lieu of ThisWorkbook.Path strPath = ThisWorkbook.Path 'Concatenate path and filename and save file _ 'Use following code for xl versions 97 - 2003 strFilename = strPath & "\" & strFilename & ".xls" ThisWorkbook.SaveAs Filename:=strFilename, _ FileFormat:=xlNormal, _ CreateBackup:=False 'Use following code for xl2007 macro enabled. 'strFilename = strPath & "\" & strFilename & ".xlsm" 'ThisWorkbook.SaveAs Filename:= strFilename , _ FileFormat:=xlOpenXMLWorkbookMacroEnabled, _ CreateBackup:=False Else 'Else only reuired if alternative code 'required if user answers no End If End Sub -- Regards, OssieMac |
|
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Save as
Hello again Mark, I am assuming that your "out of range error" was when trying to save with your required path in the code. The code you posted with ThisWorkbook.Path should work. If something does not work I suggest that you post the code didn't work and advise which line of code failed with the error message. I have modified the code to the path you requested. Until you get it working properly I suggest that you leave the space and underscore at the end of lines which is a line break in an otherwise single line of code. This allows the code to be posted on the forum and copied into the VBA editor without getting errors due to the code breaking at the wrong place. Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim strPath As String Dim strFilename As String Dim userResponse As Variant strFilename = "Week Comm " & _ Format(Sheets("Sheet1") _ .Range("N2"), "dd-mm-yyyy") userResponse = MsgBox("Do you want to save as " _ & strFilename, _ vbYesNo + vbDefaultButton2 + _ vbQuestion, "File Save") If userResponse = vbYes Then strPath = "c:\User\me\Desktop" strFilename = strPath & "\" & _ strFilename & ".xls" ThisWorkbook.SaveAs _ Filename:=strFilename, _ FileFormat:=xlNormal, _ CreateBackup:=False End If End Sub -- Regards, OssieMac |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Save, save as, page setup dimmed out in unprotected excel sheet? | Excel Discussion (Misc queries) | |||
| disable save and saveas from menubar and save via command button | Excel Programming | |||
| Disable save, save as, but allow save via command button | Excel Programming | |||
| How to diasble save and save as menu but allow a save button | Excel Programming | |||
| Totally Disabling (^ save ) (Save as) and Save Icon Which code do I use: | Excel Programming | |||
Hybrid Mode
