BEFOREPRINT SCRIPT ERRORING

bpoese

New Member
Joined
Oct 2, 2006
Messages
18
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

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 code



For 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
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).

Von Pookie

MrExcel MVP
Joined
Feb 17, 2002
Messages
13,686
Are you calling this sub from the BeforePrint event? You're probably running into a loop because you're printing during the sub.

Printing triggers the BeforePrint event. When you try to print within the printform sub, it triggers the event again, which then starts over from the beginning.

Try setting EnableEvents to false. That will stop any event macros from being triggered while your macro is running.

So:

Code:
Sub printform()

Application.EnableEvents = False 'events will not be triggered

'your code

Application.EnableEvents = True 'reset to try so events *will* be triggered

End Sub

I think your full code could probably be shortened as well, but I haven't really looked at it, yet.
 

bpoese

New Member
Joined
Oct 2, 2006
Messages
18
I didn't think about the potential loop... I'll look through it and see if I can clean it up. It makes sense because the code was originally applied only to a button control on the sheet, and I'm trying to modify it to run even if the standard print button or ctrl-P is used.


As far as shortening the code, I know for a fact it can be shortened up... I'm just glad it runs as I have basically no training in vba and have struggled through it with the help of books and this site.



Thanks for the help...
Ben
 

Forum statistics

Threads
1,136,705
Messages
5,677,300
Members
419,684
Latest member
BOB101

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top