I have created a workbook_beforeprint script that is erroring, can someone help me figure out what's going on?
When the code runs, it errors out with the first marked line below highlighted, but the code seems to have run all they way to the second marked line???
Thanks in advance for any advice given. =) Also, I can remove the lengthy code below if it's not needed... figured too much information was better than not enough.
Ben
For reference only, here is the entire code for this event:
When the code runs, it errors out with the first marked line below highlighted, but the code seems to have run all they way to the second marked line???
Thanks in advance for any advice given. =) Also, I can remove the lengthy code below if it's not needed... figured too much information was better than not enough.
Ben
Code:
Sub printform()
*lotsa code
Range("B5").Select
ActiveSheet.Unprotect
ActiveCell.FormulaR1C1 = Date ****************( *this line is highlighted in debug mode after error happens. *)
Range("C5").Select
ActiveSheet.Unprotect
ActiveCell.FormulaR1C1 = Time
Application.ScreenUpdating = False
Sheets("Parts Order Form").Select
Sheets("Parts Order Form").Copy
ActiveWorkbook.SaveAs Filename:="c:\Parts Order Backup Files\PartsOrder_" & [l5].Value & "_" & Format([b5].Value, "mmddyy") & "_" & Format([c5].Value, "hhmm") & ".xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=True, _
CreateBackup:=False
ActiveWindow.Close
Range("B2:R36").Select
Application.ScreenUpdating = True
Application.Dialogs(xlDialogPrinterSetup).Show
Application.ScreenUpdating = False
Selection.PrintOut Copies:=1, Collate:=True ********(**code is actually completed until this point??? )
Range("b7:c7").Select
ActiveCell.FormulaR1C1 = "PRINTED"
Range("b7:b7").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
*more codeFor reference only, here is the entire code for this event:
Code:
Sub printform()
If ActiveWorkbook.Name = "Parts Ordering Form.xls" Then
Dim RngB24 As Range
Set RngB24 = [B24:D24]
Dim RngB25 As Range
Set RngB25 = [B25:D25]
Dim RngB26 As Range
Set RngB26 = [B26:D26]
Dim RngB27 As Range
Set RngB27 = [B27:D27]
Dim RngB28 As Range
Set RngB28 = [B28:D28]
Dim RngB29 As Range
Set RngB29 = [B29:D29]
Dim RngB30 As Range
Set RngB30 = [B30:D30]
Dim RngB31 As Range
Set RngB31 = [B31:D31]
Dim RngB32 As Range
Set RngB32 = [B32:D32]
Dim RngB33 As Range
Set RngB33 = [B33:D33]
Dim RngB34 As Range
Set RngB34 = [B34:D34]
Dim RngB35 As Range
Set RngB35 = [B35:D35]
Dim strCustno As String
Dim strTech As String
Dim strName As String
Dim strConfirm As String
Dim OutlookApp As Outlook.Application
Dim MItem As Outlook.MailItem
Dim Cell As Range
Dim Subj As String
Dim EmailAddr As String
Dim Recipient As String
Dim Emailtext As String
Dim Msg As String
Dim Sent As String
Dim strPart As String
ActiveSheet.Unprotect
If [b7] = "" Then
Do Until strCustno <> ""
strCustno = InputBox("Please Enter Customer Number.", "Customer Number (REQUIRED):")
Loop
[b7] = strCustno
End If
If [b7] = "PRINTED" Then
reprint = MsgBox("Are you sure you want to reprint this order?", vbYesNo, "Reprint requested")
If reprint = vbNo Then
Exit Sub
End If
If reprint = vbYes Then
ActiveSheet.Unprotect
Range("B7:C7").Select
ActiveCell.FormulaR1C1 = "REPRINT"
ActiveSheet.Protect
Range("B2:R36").Select
Application.Dialogs(xlDialogPrinterSetup).Show
Selection.PrintOut Copies:=1, Collate:=True
Range("b7:c7").Select
Exit Sub
End If
End If
If [l5] = "" Then
Do Until strName <> ""
strName = InputBox("Please Enter Customer or Business Name.", "Customer Name (REQUIRED):")
Loop
[l5] = strName
End If
If [b9] = "" Then
Do Until strTech <> ""
strTech = InputBox("Please Enter Name or Tech Number of Person Placing Order.", "Ordered by (REQUIRED):")
Loop
[b9] = strTech
End If
If [b11] = "" Then
Do Until strConfirm <> ""
strConfirm = InputBox("Please enter your username.", "Form completed by (REQUIRED):")
Loop
[b11] = strConfirm
End If
If [e24].Value <> "" Then
If [B24].Value = "" Then
If [G24].Value = "" Then
strPart = MsgBox("You seem to be missing a part number. Please include either a vendor part number or Goetze Item number and try again.", vbExclamation, "Missing Part Number")
RngB24.Select
Exit Sub
End If
End If
End If
If [e25].Value <> "" Then
If [B25].Value = "" Then
If [G25].Value = "" Then
strPart = MsgBox("You seem to be missing a part number. Please include either a vendor part number or Goetze Item number and try again.", vbExclamation, "Missing Part Number")
RngB25.Select
Exit Sub
End If
End If
End If
If [e26].Value <> "" Then
If [B26].Value = "" Then
If [G26].Value = "" Then
strPart = MsgBox("You seem to be missing a part number. Please include either a vendor part number or Goetze Item number and try again.", vbExclamation, "Missing Part Number")
RngB26.Select
Exit Sub
End If
End If
End If
If [e27].Value <> "" Then
If [B27].Value = "" Then
If [G27].Value = "" Then
strPart = MsgBox("You seem to be missing a part number. Please include either a vendor part number or Goetze Item number and try again.", vbExclamation, "Missing Part Number")
RngB27.Select
Exit Sub
End If
End If
End If
If [e28].Value <> "" Then
If [B28].Value = "" Then
If [G28].Value = "" Then
strPart = MsgBox("You seem to be missing a part number. Please include either a vendor part number or Goetze Item number and try again.", vbExclamation, "Missing Part Number")
RngB28.Select
Exit Sub
End If
End If
End If
If [e29].Value <> "" Then
If [B29].Value = "" Then
If [G29].Value = "" Then
strPart = MsgBox("You seem to be missing a part number. Please include either a vendor part number or Goetze Item number and try again.", vbExclamation, "Missing Part Number")
RngB29.Select
Exit Sub
End If
End If
End If
If [e30].Value <> "" Then
If [B30].Value = "" Then
If [G30].Value = "" Then
strPart = MsgBox("You seem to be missing a part number. Please include either a vendor part number or Goetze Item number and try again.", vbExclamation, "Missing Part Number")
RngB30.Select
Exit Sub
End If
End If
End If
If [e31].Value <> "" Then
If [B31].Value = "" Then
If [G31].Value = "" Then
strPart = MsgBox("You seem to be missing a part number. Please include either a vendor part number or Goetze Item number and try again.", vbExclamation, "Missing Part Number")
RngB31.Select
Exit Sub
End If
End If
End If
If [e32].Value <> "" Then
If [B32].Value = "" Then
If [G32].Value = "" Then
strPart = MsgBox("You seem to be missing a part number. Please include either a vendor part number or Goetze Item number and try again.", vbExclamation, "Missing Part Number")
RngB32.Select
Exit Sub
End If
End If
End If
If [e33].Value <> "" Then
If [B33].Value = "" Then
If [G33].Value = "" Then
strPart = MsgBox("You seem to be missing a part number. Please include either a vendor part number or Goetze Item number and try again.", vbExclamation, "Missing Part Number")
RngB33.Select
Exit Sub
End If
End If
End If
If [e34].Value <> "" Then
If [B34].Value = "" Then
If [G34].Value = "" Then
strPart = MsgBox("You seem to be missing a part number. Please include either a vendor part number or Goetze Item number and try again.", vbExclamation, "Missing Part Number")
RngB34.Select
Exit Sub
End If
End If
End If
If [e35].Value <> "" Then
If [B35].Value = "" Then
If [G35].Value = "" Then
strPart = MsgBox("You seem to be missing a part number. Please include either a vendor part number or Goetze Item number and try again.", vbExclamation, "Missing Part Number")
RngB35.Select
Exit Sub
End If
End If
End If
Range("B5").Select
ActiveSheet.Unprotect
ActiveCell.FormulaR1C1 = Date
Range("C5").Select
ActiveSheet.Unprotect
ActiveCell.FormulaR1C1 = Time
Application.ScreenUpdating = False
Sheets("Parts Order Form").Select
Sheets("Parts Order Form").Copy
ActiveWorkbook.SaveAs Filename:="c:\Parts Order Backup Files\PartsOrder_" & [l5].Value & "_" & Format([b5].Value, "mmddyy") & "_" & Format([c5].Value, "hhmm") & ".xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=True, _
CreateBackup:=False
ActiveWindow.Close
Range("B2:R36").Select
Application.ScreenUpdating = True
Application.Dialogs(xlDialogPrinterSetup).Show
Application.ScreenUpdating = False
Selection.PrintOut Copies:=1, Collate:=True
Range("b7:c7").Select
ActiveCell.FormulaR1C1 = "PRINTED"
Range("b7:b7").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
If [b13].Value <> "Ground" Then
ActiveSheet.Unprotect
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error GoTo Handler:
Set OutlookApp = New Outlook.Application
For Each Cell In Columns("AJ").Cells.SpecialCells(xlCellTypeFormulas)
If Cell.Value Like "*@*" Then
Subj = Cell.Offset(0, 2).Value
Recipient = Cell.Offset(0, -1).Value
EmailAddr = Cell.Value
Emailtext = Cell.Offset(0, 1).Value
Set MItem = OutlookApp.CreateItem(olMailItem)
With MItem
.To = EmailAddr
.Subject = Subj
.Body = Emailtext
.Send
End With
End If
Next
ActiveSheet.Protect
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Sent = MsgBox("Notification of this order has been sent to the Service Purchaser. You will be notified of any problems with shipping this order.", vbInformation, "Order Completed")
End If
Handler:
Exit Sub
End If
If ActiveWorkbook.Name = "c:\Parts Order Backup Files\PartsOrder_" & [l5].Value & "_" & Format([b5].Value, "mmddyy") & "_" & Format([c5].Value, "hhmm") & ".xls" Then
reprint = MsgBox("Are you sure you want to reprint this order?", vbYesNo, "Reprint requested")
If reprint = vbNo Then
Exit Sub
End If
If reprint = vbYes Then
ActiveSheet.Unprotect
ActiveCell.FormulaR1C1 = "REPRINT"
ActiveSheet.Protect
Application.Dialogs(xlDialogPrinterSetup).Show
Selection.PrintOut Copies:=1, Collate:=True
Range("b7:c7").Select
End If
End If
End Sub
