W
willroy
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\Travel
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
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\Travel
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