Can anyone help!?!?!?
Hi, I am using the following code;
Sub REPORT() ' ' Application.EnableEvents = True Dim dbegin As Date, dend As Date Dim tdate As String tdate = Format(Now(), "mmm-yy") dbegin = Application.InputBox("View records issued from : ", "Start", , , , , , 1) If dbegin = 0 Then Exit Sub dend = Application.InputBox("To : ", "End", , , , , , 1) If dend = 0 Then Exit Sub UserName = Range("B8").Value workbooks.Open FileName:= _ "\\jbisvr\company\Sys\WordDocs\Graeme\TRAVEL\Trave l Sales\Commission\(" & UserName & ")New Business Log 2003.xls" '-------autofilters date field-------' Worksheets("Log").Select Range("A2:K2").Select Selection.AutoFilter Selection.AutoFilter Field:=10, Criteria1:="=" & CLng(dbegin), Operator:= _ xlAnd, Criteria2:="<=" & CLng(dend) '-------inserts footer and changes orientation--------------' ActiveSheet.PageSetup.PrintArea = "" With ActiveSheet.PageSetup ..Orientation = xlLandscape End With Sheets("TOTALS").Select With ActiveSheet.PageSetup ..Orientation = xlLandscape ..LeftFooter = _ "&D Signed............................................ ...... " End With Sheets(Array("Log", "totals")).Select ActiveWindow.SelectedSheets.PrintPreview Sheets("log").Name = tdate & ("log") Sheets("totals").Name = tdate & ("Totals") Sheets(tdate & "log").Select Dim Res As Long Res = MsgBox("Do you want to save this file? ", vbQuestion + vbYesNo) Select Case Res Case vbYes Dim sDate As String sDate = Format(Now(), "mmm-yyyy") & ".xls" Application.DisplayAlerts = False ActiveWorkbook.SaveAs FileName:="W:\Sys\WordDocs\Graeme\TRAVEL\Travel Sales\" _ & "Commission\Staffrecords\" & UserName & "\" & sDate, FileFormat:=xlWorkbookNormal Application.DisplayAlerts = True Application.EnableEvents = False Case vbNo Application.EnableEvents = False Exit Sub End Select End Sub Can anyone tell me why I am still able to save after this code is executed!!! Thank you in advance. WIll --- Message posted from http://www.ExcelForum.com/ |
Can anyone help!?!?!?
Whenever a change is made to an excel workbook, the
workbook's Saved property is set to False until the workbook is saved. In your code you ask if the user wants to save the workbook and trap a 'Yes' response. If yes, then the workbook is saved. At this point Excel sets the Saved property to True. In your code, if NO is selecte dthen nothing happens. In the following code, I set the property anyway... This replaced th elines from and including the DIM Res... as its not needed select case MsgBox("Do you want to save this file? ", vbQuestion + vbYesNo) Case vbYes Dim sDate As String sDate = Format(Now(), "mmm-yyyy") & ".xls" Application.DisplayAlerts = False ActiveWorkbook.SaveAs _ "W:\Sys\WordDocs\Graeme\TRAVEL\TravelSales\" _ & "Commission\Staffrecords\" & _ UserName & "\" & sDate, _ FileFormat:=xlWorkbookNormal Application.EnableEvents = False Case vbNo ActiveWorkbook.Saved = True End Select Application.DisplayAlerts = True Exit Sub -----Original Message----- Hi, I am using the following code; Sub REPORT() ' Application.DisplayAlerts = True Application.EnableEvents = True Dim dbegin As Date, dend As Date Dim tdate As String tdate = Format(Now(), "mmm-yy") dbegin = Application.InputBox("View records issued from : ", "Start", , , , , , 1) If dbegin = 0 Then Exit Sub dend = Application.InputBox("To : ", "End", , , , , , 1) If dend = 0 Then Exit Sub UserName = Range("B8").Value workbooks.Open FileName:= _ "\\jbisvr\company\Sys\WordDocs\Graeme\TRAVEL\Trav el Sales\Commission\(" & UserName & ")New Business Log 2003.xls" '-------autofilters date field-------' Worksheets("Log").Select Range("A2:K2").Select Selection.AutoFilter Selection.AutoFilter Field:=10, Criteria1:="=" & CLng (dbegin), Operator:= _ xlAnd, Criteria2:="<=" & CLng(dend) '-------inserts footer and changes orientation----------- ---' ActiveSheet.PageSetup.PrintArea = "" With ActiveSheet.PageSetup .Orientation = xlLandscape End With Sheets("TOTALS").Select With ActiveSheet.PageSetup .Orientation = xlLandscape .LeftFooter = _ "&D Signed............................................ ...... " End With Sheets(Array("Log", "totals")).Select ActiveWindow.SelectedSheets.PrintPreview Sheets("log").Name = tdate & ("log") Sheets("totals").Name = tdate & ("Totals") Sheets(tdate & "log").Select Dim Res As Long Res = MsgBox("Do you want to save this file? ", vbQuestion + vbYesNo) Select Case Res Case vbYes Dim sDate As String sDate = Format(Now(), "mmm-yyyy") & ".xls" Application.DisplayAlerts = False ActiveWorkbook.SaveAs FileName:="W:\Sys\WordDocs\Graeme\TRAVEL\Travel Sales\" _ & "Commission\Staffrecords\" & UserName & "\" & sDate, FileFormat:=xlWorkbookNormal Application.DisplayAlerts = True Application.EnableEvents = False Case vbNo Application.EnableEvents = False Exit Sub End Select End Sub Can anyone tell me why I am still able to save after this code is executed!!! Thank you in advance. WIll --- Message posted from http://www.ExcelForum.com/ . |
Can anyone help!?!?!?
Patrick
Its taken me ages to find out that one little code!! Thanks for your help. You don't happen to know of a code where it will actually prevent someone from saving though do you? Sp for example, if somebody simply clicks the save icon (not save as) an error message will appear saying for example "you are not able to save". Any ideas? Cheers Will --- Message posted from http://www.ExcelForum.com/ |
Can anyone help!?!?!?
Sure,
Use the Before Save event like I told you back on the 12th. Of course any macro based solution is easily defeated if the user disables macros, including your macro. My recommendation of making the workbook readonly might be the best approach although that can be changed as well. -- Regards, Tom Ogilvy "willroy" wrote in message ... Patrick Its taken me ages to find out that one little code!! Thanks for your help. You don't happen to know of a code where it will actually prevent someone from saving though do you? Sp for example, if somebody simply clicks the save icon (not save as) an error message will appear saying for example "you are not able to save". Any ideas? Cheers Will --- Message posted from http://www.ExcelForum.com/ |
All times are GMT +1. The time now is 02:48 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com