Print Event intercept...

GUIDO22

Registered User.
Local time
Today, 22:58
Joined
Nov 2, 2003
Messages
515
I have a report that is initiated from a dialog box. From commandbuttons on the dialog - I can preview or print (my own print function).
When the user prints the form I need to run some additional code....

However, if the user previews the form and then runs the Print option from the context /shortcut menu(right mouse click) - this appears to use the standard windows Print function - meaning they can bypass my code block that I need to run. I dont want to disable the context menu preferring to leave the feature there as users are quite used to using it... how can i intercept Printing from this context menu and add the call to my additional routine...?

Thanks in advance
 
i don't think you can intercept it.
you can of course create a new Shortcut menu that
does not have the Print menu.
 
you can of course create a new Shortcut menu that
does not have the Print menu.
Or even better, that has a custom print command that looks like the built-in one, but invokes the custom print procedure.
 
I have used a Custom context menu elsewhere in my project (have done so on a form) . I have used similar code that is called on the mouseup() event of the report in question but the default Shortcut menu still displays...?
 
I have used similar code that is called on the mouseup() event of the report in question but the default Shortcut menu still displays...?
I don't think mouse events will be raised in Print Preview. Just change the ShortcutMenuBar property of the report to your custom menu.
 
unable to create Export menu:
Code:
'arnelgp
Private Sub myPrintReportShortcut()
    Dim cmbRightClick As Office.CommandBar
    Dim cmbControl As Office.CommandBarControl
 
    On Error Resume Next
    CommandBars("cmdReportRightClick").Delete
    
    On Error GoTo 0
   ' Create the shortcut menu.
  
    ' .Add (Name, Position, MenuBar, Temporary)
    
    Set cmbRightClick = CommandBars.Add("cmdReportRightClick", msoBarPopup, False, True)
 
    With cmbRightClick
        
        ' .Add (Type, Id, Parameter, Before, Temporary)
        

        Set cmbControl = .Controls.Add(msoControlButton, 11253, , , True)
        ' Change the caption displayed for the control.
        cmbControl.Caption = "&Report View"
        
        Set cmbControl = .Controls.Add(msoControlButton, 13157, , , True)
        ' Change the caption displayed for the control.
        cmbControl.Caption = "La&yout View"
        

        Set cmbControl = .Controls.Add(msoControlButton, 2952, , , True)
        ' Change the caption displayed for the control.
        cmbControl.Caption = "&Design View"
        

        Set cmbControl = .Controls.Add(msoControlButton, 109, , , True)
        cmbControl.Caption = "Print Pre&view"
        
        ' Start a new group.
        cmbControl.BeginGroup = True
        
        Set cmbControl = .Controls.Add(msoControlComboBox, 1733, , , True)
        cmbControl.Caption = "&Zoom:"
        
        Set cmbControl = .Controls.Add(msoControlButton, 5, , , True)
        cmbControl.Caption = "&One Page"
        
        Set cmbControl = .Controls.Add(msoControlExpandingGrid, 177, , , True)
        cmbControl.Caption = "&Multiple Pages"
        
        
        ' Start a new group.
        cmbControl.BeginGroup = True
        
        Set cmbControl = .Controls.Add(msoControlButton, 247, , , True)
        cmbControl.Caption = "Page Set&up..."
        
        'custom print
        Set cmbControl = .Controls.Add
        With cmbControl
            .Caption = "Print"
            .OnAction = "=fnPrint()"
            .FaceId = 745
        End With
        
    
        ' Start a new group.
        cmbControl.BeginGroup = True
    
        Set cmbControl = .Controls.Add(msoControlButton, 748, , , True)
        cmbControl.Caption = "Save &As..."
    
        'can't get this to work
        'Set cmbControl = .Controls.Add(10, 31458, , , True)
        'cmbControl.Caption = "&Export"
    
        Set cmbControl = .Controls.Add(10, 30095, , , True)
        cmbControl.Caption = "Sen&d To"
    
    
        ' Start a new group.
        cmbControl.BeginGroup = True
    
        Set cmbControl = .Controls.Add(msoControlButton, 14782, , , True)
        cmbControl.Caption = "&Close"
    
    End With
    
    Set cmbControl = Nothing
    Set cmbRightClick = Nothing

End Sub

Public Function fnPrint()
MsgBox "put your code here!"
End Function
 
What business process are you trying to implement? Once the Report is opened in preview, unless you have turned off all ribbons, you don't have any control over the print process.
 
this is now complete
Code:
'arnelgp
'arnelgp
Private Sub myPrintReportShortcut()
    Dim cmbRightClick As Office.CommandBar
    Dim cmbControl As Office.CommandBarControl
 
    Dim SubMenuItm As CommandBarControl
    
    On Error Resume Next
    CommandBars("cmdReportRightClick").Delete
    
    On Error GoTo 0
   ' Create the shortcut menu.
   
    ' .Add (Name, Position, MenuBar, Temporary)
    
    Set cmbRightClick = CommandBars.Add("cmdReportRightClick", msoBarPopup, False, False)
 
    With cmbRightClick
        
        ' .Add (Type, Id, Parameter, Before, Temporary)
        

        Set cmbControl = .Controls.Add(msoControlButton, 11253, , , False)
        ' Change the caption displayed for the control.
        cmbControl.Caption = "&Report View"
         
        Set cmbControl = .Controls.Add(msoControlButton, 13157, , , False)
        ' Change the caption displayed for the control.
        cmbControl.Caption = "La&yout View"
         

        Set cmbControl = .Controls.Add(msoControlButton, 2952, , , False)
        ' Change the caption displayed for the control.
        cmbControl.Caption = "&Design View"
         

        Set cmbControl = .Controls.Add(msoControlButton, 109, , , False)
        cmbControl.Caption = "Print Pre&view"
        
        
        Set cmbControl = .Controls.Add(msoControlComboBox, 1733, , , False)
        cmbControl.Caption = "&Zoom:"
        
        ' Start a new group.
        cmbControl.BeginGroup = True
        
        Set cmbControl = .Controls.Add(msoControlButton, 5, , , False)
        cmbControl.Caption = "&One Page"
        
        Set cmbControl = .Controls.Add(msoControlExpandingGrid, 177, , , False)
        cmbControl.Caption = "&Multiple Pages"
        
        
        
        Set cmbControl = .Controls.Add(msoControlButton, 247, , , False)
        cmbControl.Caption = "Page Set&up..."
        
        ' Start a new group.
        cmbControl.BeginGroup = True
        
        'custom print
        Set cmbControl = .Controls.Add
        With cmbControl
            .Caption = "Print"
            .OnAction = "=fnPrint()"
            .FaceId = 745
        End With
        
        Set cmbControl = .Controls.Add(msoControlButton, 748, , , False)
        cmbControl.Caption = "Save &As..."
    
        ' Start a new group.
        cmbControl.BeginGroup = True
        
        Set cmbControl = .Controls.Add(msoControlButton, 14782, , , False)
        cmbControl.Caption = "&Close"
        
        With .Controls.Add(Type:=msoControlPopup, before:=11)
            .Caption = "Sen&d To"
            With .Controls.Add(msoControlButton, 2188, , , False)
                .Caption = "M&ail Recipient (as Attachment)..."
                '.FaceId = 258
                '.OnAction = "=fnMyMail()"
            End With
        
        End With
        
        ' create this sub menu first
        With .Controls.Add(Type:=msoControlPopup, before:=11)
            .Tag = "submenu1"
            .Caption = "&Export"
    
            With .Controls.Add(msoControlButton, 11723)
                .Caption = "E&xcel"
            End With
            With .Controls.Add(msoControlButton, 11724)
                .Caption = "SharePoint Li&st"
            End With
            With .Controls.Add(msoControlButton, 11725)
                .Caption = "&Word RTF File"
            End With
            With .Controls.Add(msoControlButton, 12951)
                .Caption = "&PDF or XPS"
            End With
            With .Controls.Add(msoControlButton, 11726)
                .Caption = "&Access"
            End With
            With .Controls.Add(msoControlButton, 11727)
                .Caption = "&Text File"
            End With
            With .Controls.Add(msoControlButton, 11728)
                .Caption = "XM&L File"
            End With
            With .Controls.Add(msoControlButton, 11729)
                .Caption = "&ODB&C Database"
            End With
            With .Controls.Add(msoControlButton, 11731)
                .Caption = "&HTML Document"
            End With
            With .Controls.Add(msoControlButton, 11732)
                .Caption = "d&BASE File"
            End With
            With .Controls.Add(msoControlButton, 626)
                .Caption = "&Word Merge"
            End With
            
        End With
        ' Start a new group.
        cmbControl.BeginGroup = True
    
    End With
     
    Set cmbControl = Nothing
    Set cmbRightClick = Nothing

End Sub
:
 
Last edited:
I don't think mouse events will be raised in Print Preview. Just change the ShortcutMenuBar property of the report to your custom menu

this is now complete
Code:
'arnelgp
'arnelgp
Private Sub myPrintReportShortcut()
    Dim cmbRightClick As Office.CommandBar
    Dim cmbControl As Office.CommandBarControl

    Dim SubMenuItm As CommandBarControl
   
    On Error Resume Next
    CommandBars("cmdReportRightClick").Delete
   
    On Error GoTo 0
   ' Create the shortcut menu.
  
    ' .Add (Name, Position, MenuBar, Temporary)
   
    Set cmbRightClick = CommandBars.Add("cmdReportRightClick", msoBarPopup, False, False)

    With cmbRightClick
       
        ' .Add (Type, Id, Parameter, Before, Temporary)
       

        Set cmbControl = .Controls.Add(msoControlButton, 11253, , , False)
        ' Change the caption displayed for the control.
        cmbControl.Caption = "&Report View"
        
        Set cmbControl = .Controls.Add(msoControlButton, 13157, , , False)
        ' Change the caption displayed for the control.
        cmbControl.Caption = "La&yout View"
        

        Set cmbControl = .Controls.Add(msoControlButton, 2952, , , False)
        ' Change the caption displayed for the control.
        cmbControl.Caption = "&Design View"
        

        Set cmbControl = .Controls.Add(msoControlButton, 109, , , False)
        cmbControl.Caption = "Print Pre&view"
       
       
        Set cmbControl = .Controls.Add(msoControlComboBox, 1733, , , False)
        cmbControl.Caption = "&Zoom:"
       
        ' Start a new group.
        cmbControl.BeginGroup = True
       
        Set cmbControl = .Controls.Add(msoControlButton, 5, , , False)
        cmbControl.Caption = "&One Page"
       
        Set cmbControl = .Controls.Add(msoControlExpandingGrid, 177, , , False)
        cmbControl.Caption = "&Multiple Pages"
       
       
       
        Set cmbControl = .Controls.Add(msoControlButton, 247, , , False)
        cmbControl.Caption = "Page Set&up..."
       
        ' Start a new group.
        cmbControl.BeginGroup = True
       
        'custom print
        Set cmbControl = .Controls.Add
        With cmbControl
            .Caption = "Print"
            .OnAction = "=fnPrint()"
            .FaceId = 745
        End With
       
        Set cmbControl = .Controls.Add(msoControlButton, 748, , , False)
        cmbControl.Caption = "Save &As..."
   
        ' Start a new group.
        cmbControl.BeginGroup = True
       
        Set cmbControl = .Controls.Add(msoControlButton, 14782, , , False)
        cmbControl.Caption = "&Close"
       
        With .Controls.Add(Type:=msoControlPopup, before:=11)
            .Caption = "Sen&d To"
            With .Controls.Add(msoControlButton, 2188, , , False)
                .Caption = "M&ail Recipient (as Attachment)..."
                '.FaceId = 258
                '.OnAction = "=fnMyMail()"
            End With
       
        End With
       
        ' create this sub menu first
        With .Controls.Add(Type:=msoControlPopup, before:=11)
            .Tag = "submenu1"
            .Caption = "&Export"
   
            With .Controls.Add(msoControlButton, 11723)
                .Caption = "E&xcel"
            End With
            With .Controls.Add(msoControlButton, 11724)
                .Caption = "SharePoint Li&st"
            End With
            With .Controls.Add(msoControlButton, 11725)
                .Caption = "&Word RTF File"
            End With
            With .Controls.Add(msoControlButton, 12951)
                .Caption = "&PDF or XPS"
            End With
            With .Controls.Add(msoControlButton, 11726)
                .Caption = "&Access"
            End With
            With .Controls.Add(msoControlButton, 11727)
                .Caption = "&Text File"
            End With
            With .Controls.Add(msoControlButton, 11728)
                .Caption = "XM&L File"
            End With
            With .Controls.Add(msoControlButton, 11729)
                .Caption = "&ODB&C Database"
            End With
            With .Controls.Add(msoControlButton, 11731)
                .Caption = "&HTML Document"
            End With
            With .Controls.Add(msoControlButton, 11732)
                .Caption = "d&BASE File"
            End With
            With .Controls.Add(msoControlButton, 626)
                .Caption = "&Word Merge"
            End With
           
        End With
        ' Start a new group.
        cmbControl.BeginGroup = True
   
    End With
    
    Set cmbControl = Nothing
    Set cmbRightClick = Nothing

End Sub
:
Looks good... however, when I attempt to reference this routine in the Shortcut Menu Bar property on the report, the dropdown displays empty.
If I type the routine name : myPrintReportShortcut, when I run, it errors saying : cannot find the object 'myPrintReportShortcut'...?
 
you first need to Run (F5) the the sub myPrintReportShortcut().
then you bring your report in design view and on Property->Other->Shortcut Menu Bar, put "cmdReportRightClick" (without the quote).
 
this is now complete
Code:
'arnelgp
'arnelgp
Private Sub myPrintReportShortcut()
    Dim cmbRightClick As Office.CommandBar
    Dim cmbControl As Office.CommandBarControl

    Dim SubMenuItm As CommandBarControl
   
    On Error Resume Next
    CommandBars("cmdReportRightClick").Delete
   
    On Error GoTo 0
   ' Create the shortcut menu.
  
    ' .Add (Name, Position, MenuBar, Temporary)
   
    Set cmbRightClick = CommandBars.Add("cmdReportRightClick", msoBarPopup, False, False)

    With cmbRightClick
       
        ' .Add (Type, Id, Parameter, Before, Temporary)
       

        Set cmbControl = .Controls.Add(msoControlButton, 11253, , , False)
        ' Change the caption displayed for the control.
        cmbControl.Caption = "&Report View"
        
        Set cmbControl = .Controls.Add(msoControlButton, 13157, , , False)
        ' Change the caption displayed for the control.
        cmbControl.Caption = "La&yout View"
        

        Set cmbControl = .Controls.Add(msoControlButton, 2952, , , False)
        ' Change the caption displayed for the control.
        cmbControl.Caption = "&Design View"
        

        Set cmbControl = .Controls.Add(msoControlButton, 109, , , False)
        cmbControl.Caption = "Print Pre&view"
       
       
        Set cmbControl = .Controls.Add(msoControlComboBox, 1733, , , False)
        cmbControl.Caption = "&Zoom:"
       
        ' Start a new group.
        cmbControl.BeginGroup = True
       
        Set cmbControl = .Controls.Add(msoControlButton, 5, , , False)
        cmbControl.Caption = "&One Page"
       
        Set cmbControl = .Controls.Add(msoControlExpandingGrid, 177, , , False)
        cmbControl.Caption = "&Multiple Pages"
       
       
       
        Set cmbControl = .Controls.Add(msoControlButton, 247, , , False)
        cmbControl.Caption = "Page Set&up..."
       
        ' Start a new group.
        cmbControl.BeginGroup = True
       
        'custom print
        Set cmbControl = .Controls.Add
        With cmbControl
            .Caption = "Print"
            .OnAction = "=fnPrint()"
            .FaceId = 745
        End With
       
        Set cmbControl = .Controls.Add(msoControlButton, 748, , , False)
        cmbControl.Caption = "Save &As..."
   
        ' Start a new group.
        cmbControl.BeginGroup = True
       
        Set cmbControl = .Controls.Add(msoControlButton, 14782, , , False)
        cmbControl.Caption = "&Close"
       
        With .Controls.Add(Type:=msoControlPopup, before:=11)
            .Caption = "Sen&d To"
            With .Controls.Add(msoControlButton, 2188, , , False)
                .Caption = "M&ail Recipient (as Attachment)..."
                '.FaceId = 258
                '.OnAction = "=fnMyMail()"
            End With
       
        End With
       
        ' create this sub menu first
        With .Controls.Add(Type:=msoControlPopup, before:=11)
            .Tag = "submenu1"
            .Caption = "&Export"
   
            With .Controls.Add(msoControlButton, 11723)
                .Caption = "E&xcel"
            End With
            With .Controls.Add(msoControlButton, 11724)
                .Caption = "SharePoint Li&st"
            End With
            With .Controls.Add(msoControlButton, 11725)
                .Caption = "&Word RTF File"
            End With
            With .Controls.Add(msoControlButton, 12951)
                .Caption = "&PDF or XPS"
            End With
            With .Controls.Add(msoControlButton, 11726)
                .Caption = "&Access"
            End With
            With .Controls.Add(msoControlButton, 11727)
                .Caption = "&Text File"
            End With
            With .Controls.Add(msoControlButton, 11728)
                .Caption = "XM&L File"
            End With
            With .Controls.Add(msoControlButton, 11729)
                .Caption = "&ODB&C Database"
            End With
            With .Controls.Add(msoControlButton, 11731)
                .Caption = "&HTML Document"
            End With
            With .Controls.Add(msoControlButton, 11732)
                .Caption = "d&BASE File"
            End With
            With .Controls.Add(msoControlButton, 626)
                .Caption = "&Word Merge"
            End With
           
        End With
        ' Start a new group.
        cmbControl.BeginGroup = True
   
    End With
    
    Set cmbControl = Nothing
    Set cmbRightClick = Nothing

End Sub
:
@arnelgp
What controls what is enabled/disabled on that menu, like Sharepoint for instance?
 
enabled/disabled on that menu, like Sharepoint for instance?
i just added those Controls (to mimic the default).
Access actually took control of what get Enabled/disabled.
 
this is now complete
Code:
'arnelgp
'arnelgp
Private Sub myPrintReportShortcut()
    Dim cmbRightClick As Office.CommandBar
    Dim cmbControl As Office.CommandBarControl

    Dim SubMenuItm As CommandBarControl
   
    On Error Resume Next
    CommandBars("cmdReportRightClick").Delete
   
    On Error GoTo 0
   ' Create the shortcut menu.
  
    ' .Add (Name, Position, MenuBar, Temporary)
   
    Set cmbRightClick = CommandBars.Add("cmdReportRightClick", msoBarPopup, False, False)

    With cmbRightClick
       
        ' .Add (Type, Id, Parameter, Before, Temporary)
       

        Set cmbControl = .Controls.Add(msoControlButton, 11253, , , False)
        ' Change the caption displayed for the control.
        cmbControl.Caption = "&Report View"
        
        Set cmbControl = .Controls.Add(msoControlButton, 13157, , , False)
        ' Change the caption displayed for the control.
        cmbControl.Caption = "La&yout View"
        

        Set cmbControl = .Controls.Add(msoControlButton, 2952, , , False)
        ' Change the caption displayed for the control.
        cmbControl.Caption = "&Design View"
        

        Set cmbControl = .Controls.Add(msoControlButton, 109, , , False)
        cmbControl.Caption = "Print Pre&view"
       
       
        Set cmbControl = .Controls.Add(msoControlComboBox, 1733, , , False)
        cmbControl.Caption = "&Zoom:"
       
        ' Start a new group.
        cmbControl.BeginGroup = True
       
        Set cmbControl = .Controls.Add(msoControlButton, 5, , , False)
        cmbControl.Caption = "&One Page"
       
        Set cmbControl = .Controls.Add(msoControlExpandingGrid, 177, , , False)
        cmbControl.Caption = "&Multiple Pages"
       
       
       
        Set cmbControl = .Controls.Add(msoControlButton, 247, , , False)
        cmbControl.Caption = "Page Set&up..."
       
        ' Start a new group.
        cmbControl.BeginGroup = True
       
        'custom print
        Set cmbControl = .Controls.Add
        With cmbControl
            .Caption = "Print"
            .OnAction = "=fnPrint()"
            .FaceId = 745
        End With
       
        Set cmbControl = .Controls.Add(msoControlButton, 748, , , False)
        cmbControl.Caption = "Save &As..."
   
        ' Start a new group.
        cmbControl.BeginGroup = True
       
        Set cmbControl = .Controls.Add(msoControlButton, 14782, , , False)
        cmbControl.Caption = "&Close"
       
        With .Controls.Add(Type:=msoControlPopup, before:=11)
            .Caption = "Sen&d To"
            With .Controls.Add(msoControlButton, 2188, , , False)
                .Caption = "M&ail Recipient (as Attachment)..."
                '.FaceId = 258
                '.OnAction = "=fnMyMail()"
            End With
       
        End With
       
        ' create this sub menu first
        With .Controls.Add(Type:=msoControlPopup, before:=11)
            .Tag = "submenu1"
            .Caption = "&Export"
   
            With .Controls.Add(msoControlButton, 11723)
                .Caption = "E&xcel"
            End With
            With .Controls.Add(msoControlButton, 11724)
                .Caption = "SharePoint Li&st"
            End With
            With .Controls.Add(msoControlButton, 11725)
                .Caption = "&Word RTF File"
            End With
            With .Controls.Add(msoControlButton, 12951)
                .Caption = "&PDF or XPS"
            End With
            With .Controls.Add(msoControlButton, 11726)
                .Caption = "&Access"
            End With
            With .Controls.Add(msoControlButton, 11727)
                .Caption = "&Text File"
            End With
            With .Controls.Add(msoControlButton, 11728)
                .Caption = "XM&L File"
            End With
            With .Controls.Add(msoControlButton, 11729)
                .Caption = "&ODB&C Database"
            End With
            With .Controls.Add(msoControlButton, 11731)
                .Caption = "&HTML Document"
            End With
            With .Controls.Add(msoControlButton, 11732)
                .Caption = "d&BASE File"
            End With
            With .Controls.Add(msoControlButton, 626)
                .Caption = "&Word Merge"
            End With
           
        End With
        ' Start a new group.
        cmbControl.BeginGroup = True
   
    End With
    
    Set cmbControl = Nothing
    Set cmbRightClick = Nothing

End Sub
:


The idea to solve this problem is really interesting
I'm trying to use the code you proposed, but how to extract information from the report on which this command bar is used?
Basically, if I start the rptDocument when I right-mouse / Print it starts the fnPrint() correctly
But I don't know what the previewed document is
I tried inserting a textbox name
.OnAction = "=fnPrint(txtIDdocument)"
but it does not work

Then the question is: how to pass to the fnPrint() a value corresponding to the document whose report is open in preview?
 

Users who are viewing this thread

Back
Top Bottom