Disable print of opened workbook

[CsJHUN]

Hi guys, i would like to disable any kind of print option of the opened file (excel or ppt mainly).
There is a wb which contain the macro. In this wb there is ~4k link (let's says its a master list of xlsx, pptx, ....) I would like to diable any kind of printing possibilities on that files.
I thought i write a wb_deactivate/window_deactivate event then disable. After opened file are closed, the printing should be enabled again.

I familiar with wb_beforeprint event, but that should be in each and every file linked to this master list file, right? Also tried playing along with disabling the Print and Print... option (which not worked flawlessly ) but there is still the Ctrl+P shortcut

Any workaround, ideas, solutions?
Thanks

 

[Krayna]

Don't know if you tried this option yet??

Disabling Printing (Microsoft Excel)

Don't want your worksheets to be printed out? You can make it a bit harder to get a printout by applying the techniques in this tip. (Tips.Net)

excel.tips.net

Another idea is to disable Ctrl+P shortcut like this:

Sub DisableCtrlP()
Application.OnKey "^p",""
End Sub

Sub RestoreCtrlP()
Application.OnKey "^p"
End Sub

 

[Jaafar Tribak]

You could use an addin so, Printing will be diabled in any workbook .

Create an excel (.xla or xlam) Addin and add the following code in the addin ThisWorkbook Module:

Option Explicit

Private WithEvents AppEvents As Application

Private Sub Workbook_Open()
    Set AppEvents = Application
End Sub

Private Sub AppEvents_WorkbookBeforePrint(ByVal Wb As Workbook, Cancel As Boolean)
    Cancel = True
End Sub

 

[Jaafar Tribak]

Just re-read the question and since it seems you have a list of NOT-TO-BE-PRINTED files in the master workbook then I wouldn't use an addin... Instead, I would put the following code in the ThisWorkbook Module of the master workbook :

Note: The code assumes that the files List is located in Sheet1, Column("A") an that the list displays the full path of the files including the file extensions.... change the list location in the code as required.

Option Explicit

Private WithEvents AppEvents As Application

Private Sub Workbook_Open()
    Set AppEvents = Application
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If AppEvents Is Nothing Then
        Set AppEvents = Application
    End If
End Sub

Private Sub AppEvents_WorkbookBeforePrint(ByVal Wb As Workbook, Cancel As Boolean)

    Dim vFilesList() As Variant

    With Sheet1
        vFilesList() = Application.Transpose(.Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp)))
    End With
    If Not IsError(Application.Match(Wb.FullName, vFilesList, 0)) Then
      'A file in the list is about to be printed, so abort the printing now.
      Cancel = True
    End If
    
End Sub

 

[CsJHUN]

Don't know if you tried this option yet??

Disabling Printing (Microsoft Excel)

Don't want your worksheets to be printed out? You can make it a bit harder to get a printout by applying the techniques in this tip. (Tips.Net)

excel.tips.net

Another idea is to disable Ctrl+P shortcut like this:

Sub DisableCtrlP()
Application.OnKey "^p",""
End Sub

Sub RestoreCtrlP()
Application.OnKey "^p"
End Sub

Allen version was the first go. But not thought about disabling ctrl+p, ty

Just re-read the question and since it seems you have a list of NOT-TO-BE-PRINTED files in the master workbook then I wouldn't use an addin... Instead, I would put the following code in the ThisWorkbook Module of the master workbook :

Note: The code assumes that the files List is located in Sheet1, Column("A") an that the list displays the full path of the files including the file extensions.... change the list location in the code as required.

Option Explicit

Private WithEvents AppEvents As Application

Private Sub Workbook_Open()
    Set AppEvents = Application
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If AppEvents Is Nothing Then
        Set AppEvents = Application
    End If
End Sub

Private Sub AppEvents_WorkbookBeforePrint(ByVal Wb As Workbook, Cancel As Boolean)

    Dim vFilesList() As Variant

    With Sheet1
        vFilesList() = Application.Transpose(.Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp)))
    End With
    If Not IsError(Application.Match(Wb.FullName, vFilesList, 0)) Then
      'A file in the list is about to be printed, so abort the printing now.
      Cancel = True
    End If
 
End Sub

with minor editing ('with sheets(1)', and set the transponse range to my needs) this is what im looking for.

Thanks guys

 

[CsJHUN]

ok there is one more problem, what if its not a workbook (xlsx, xls, ...) but presentation (ppt, pptx), or document (doc, docx)?

 

[Jaafar Tribak]

ok there is one more problem, what if its not a workbook (xlsx, xls, ...) but presentation (ppt, pptx), or document (doc, docx)?

How are you opening the pptx and docx files from the list ?

 

[CsJHUN]

How are you opening the pptx and docx files from the list ?

Same as excel.
there is a link in column H (formula concatenate from several other cells of same row) one of these cells tells if its xlsx or pptx. (Other project need pptx and docx) Here is the exact formula in H col.
=IF(E15<>"",HYPERLINK(settings!$B$1 &CONCATENATE(A15,"\",E15,IF(A15="OPL",".pptx",".xlsx")),1),"")
Range("B1") = base link of the main folder
Col A: a category with dropdown list, also its a subfolder name
Col E: contain the file name part before the extension like "doc_name" or "abdu2_sd82jk8_hvu4_"
Col H: Then this formula check col "A" if its "OPL" then the extension is ".pptx" . With above examples the file name will be: "doc_name.pptx" or "abdu2_sd82jk8_hvu4_.pptx" . If the col "A" is not "OPL" then it will be "doc_name.xlsx" or "abdu2_sd82jk8_hvu4_.xlsx"

 

[Jaafar Tribak]

Sinking the Print events for DOCX or PPTX documents is not going to be as straightforward as sinking the Print event for newly opened excel workbooks. This is because the docx and pptx documents will be launched in their own seperate applications so we will first need to somehow find a way of getting a reference pointer to each opened docx and pptx.

That said, I think we can make this work for docx but, it is going to be much more difficult to sink the Print event of pptx documents as I have just found out that the PowerPoint Print event handler doesn't provide a Cancel Argument.

Cancel argument is missing in powerpoint:

Private Sub PPTAppEvents_PresentationPrint(ByVal Pres As PowerPoint.Presentation)

Anyways, I'll give this a try and let you know .

 

[Jaafar Tribak]

CsJHUN​

Sorry for not responding sooner.

File Demo:
CancelPrint.xls

Ok- First of all, this only works for cancelling printing of excel workbooks and word documents opened in the current application instance and\or in seperate ones ... It doesn't work though for PPT presentations because, like I mentioned in my earlier post, PPT doesn't provide a Cancel argument in the BeforePrint event handler.

Secondly, the project requires that you set a reference to the microsoft word object library.

Third, The code is based on a userform that implements the IPrintWatcher interface and which is also conviniently used for sinking the Print events and as a UI feedback window that comes up whenever a printing operation is cancelled.

The project contains several seperate modules but, you only need to use the module named : bas_Test
All 3 other modules need to be left alone.

This is a code usage example ( bas_Test module )
Note: I am assuming that the file list range is Sheet1.Column(A) ... change range to suit.

Option Explicit

Dim oPrintWatcher As IPrintWatcher

Sub Start()
    Dim oFileListRange As Range
    If oPrintWatcher Is Nothing Then
        Set oPrintWatcher = New UPrintWatcher
        Set oFileListRange = Sheet1.Range(Sheet1.Cells(1, "A"), Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp))
        Set oPrintWatcher.FileListRange = oFileListRange
        Call oPrintWatcher.StartWatching
    End If
End Sub

Sub Finish()
    If Not oPrintWatcher Is Nothing Then
        Call oPrintWatcher.StopWatching
        Set oPrintWatcher = Nothing
    End If
End Sub

And, here are the other 3 supporting modules:

1- IPrintWatcher (Interface Class Module):

Option Explicit

Public Property Set FileListRange(ByVal FileList As Range)
    '
End Property
Public Sub StartWatching()
    '
End Sub
Public Sub StopWatching()
    '
End Sub

2- UPrintWatcher (UserForm Module)

Option Explicit

Implements IPrintWatcher
Private WithEvents ExcelAppEvents As Excel.Application
Private WithEvents WordAppEvents As Word.Application

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #Else
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    #End If
    Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hwnd As LongPtr, ByVal dwId As Long, ByVal riid As LongPtr, ByVal ppvObject As LongPtr) As Long
    Private Declare PtrSafe Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, ByVal lpiid As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetDefaultPrinter Lib "winspool.drv" Alias "GetDefaultPrinterA" (ByVal pszBuffer As String, pcchBuffer As Long) As Long
#Else
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hwnd As Long) As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Private Declare Function GetForegroundWindow Lib "user32" () As Long
    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Private Declare Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hwnd As Long, ByVal dwId As Long, ByVal riid As Long, ByVal ppvObject As Long) As Long
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As Long, ByVal lpiid As Long) As Long
    Private Declare Function GetDefaultPrinter Lib "winspool.drv" Alias "GetDefaultPrinterA" (ByVal pszBuffer As String, pcchBuffer As Long) As Long
#End If

Private oFileListRange As Range


'IPrinterWatcher Interface Functions.
Private Property Set IPrintWatcher_FileListRange(ByVal FileList As Range)
    Set oFileListRange = FileList
End Property
Private Sub IPrintWatcher_StartWatching()
    Call StartTimer
End Sub
Private Sub IPrintWatcher_StopWatching()
    Call StopTimer
    Set WordAppEvents = Nothing
    Unload Me
End Sub


'UPrinterWatcher UserForm Open\Close\Hide.
Private Sub UserForm_Initialize()
    Me.Tag = "PrintWatcher"
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = 0 Then
        Cancel = True
        Me.Hide
    Else
        Cancel = False
    End If
End Sub
Private Sub CommandButton1_Click()
    Me.Hide
End Sub


'EXCEL\WORD BeforePrint Events.
Private Sub ExcelAppEvents_WorkbookBeforePrint(ByVal Wb As Workbook, Cancel As Boolean)
    Cancel = CancelPrinting(Wb)
End Sub
Private Sub WordAppEvents_DocumentBeforePrint(ByVal Doc As Word.Document, Cancel As Boolean)
    Cancel = CancelPrinting(Doc)
End Sub


'Supporting Routines.
Private Function CancelPrinting(ByVal oObj As Object) As Boolean
    Const GWL_HWNDPARENT = (-8)
    #If Win64 Then
        Dim hwnd As LongLong
    #Else
        Dim hwnd As Long
    #End If
    Dim vFilesList() As Variant
  
    If Evaluate("CountA(" & oFileListRange.Address & ")") Then
        vFilesList() = Application.Transpose(oFileListRange)
        If Not IsError(Application.Match(oObj.FullName, vFilesList, 0)) Then
            'A file in the list (oFileListRange) is about to be printed, so abort the printing now.
            CancelPrinting = True
            Call IUnknown_GetWindow(Me, VarPtr(hwnd))
            Call SetWindowLong(hwnd, GWL_HWNDPARENT, GetForegroundWindow)
            With Me
                .Caption = GetPrinterName
                .Label1.Caption = "Sorry, printing is disabled for the following file :"
                .Label2.Caption = Chr(149) & "  " & oObj.FullName
                .Show vbModeless
            End With
        End If
    End If
End Function


#If Win64 Then
    Private Function GetObjectRef(ByVal hwnd As LongLong, ByVal sClassName As String) As Object
#Else
    Private Function GetObjectRef(ByVal hwnd As Long, ByVal sClassName As String) As Object
#End If

    Const IID_DISPATCH = "{00020400-0000-0000-C000-000000000046}"
    Const OBJID_NATIVEOM = &HFFFFFFF0
    Const S_OK = 0&
  
    Dim tDisp(0 To 3) As Long
    Dim oWnd As Object
  
    If IIDFromString(StrPtr(IID_DISPATCH), VarPtr(tDisp(0))) = S_OK Then
        Select Case sClassName
            Case "OpusApp"  'Word App
                hwnd = FindWindowEx(hwnd, 0&, "_WwF", vbNullString)
                hwnd = FindWindowEx(hwnd, 0&, "_WwB", vbNullString)
                hwnd = FindWindowEx(hwnd, 0&, "_WwG", vbNullString)
            Case "XLMAIN"     'Excel App
                hwnd = FindWindowEx(hwnd, 0&, "XLDESK", vbNullString)
                hwnd = FindWindowEx(hwnd, 0&, "EXCEL7", vbNullString)
        End Select
      
        If hwnd Then
            If AccessibleObjectFromWindow(hwnd, OBJID_NATIVEOM, VarPtr(tDisp(0)), VarPtr(oWnd)) = S_OK Then
                Set GetObjectRef = oWnd.Application
            End If
        End If
    End If

End Function


Private Function GetPrinterName() As String
    Dim sBuffer As String, lSize As Long
    Call GetDefaultPrinter(vbNullString, lSize)
    sBuffer = Space(lSize)
    Call GetDefaultPrinter(sBuffer, lSize)
    GetPrinterName = Left(sBuffer, Len(sBuffer) - 1)
End Function


Public Function TimerProc()
    #If Win64 Then
        Dim hwnd As LongLong
    #Else
        Dim hwnd As Long
    #End If
    Dim sBuffer As String * 256, lRet As Long

    On Error Resume Next
        hwnd = GetForegroundWindow
        lRet = GetClassName(hwnd, sBuffer, 256)
        Select Case True
            Case Left(sBuffer, lRet) = "XLMAIN"
                Set ExcelAppEvents = GetObjectRef(hwnd, "XLMAIN")
            Case Left(sBuffer, lRet) = "OpusApp"
                Set WordAppEvents = GetObjectRef(hwnd, "OpusApp")
        End Select
    On Error GoTo 0
End Function

3- bas_Timer (Standard Module)

Option Explicit

Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long


Sub StartTimer(Optional ByVal Dummy As Boolean)
    If VBA.UserForms.Count = 0 Then Call StopTimer: Exit Sub
    Call SetTimer(Application.hwnd, 0, 1000, AddressOf DO_NOT_USE_THIS_FUNCTION)
End Sub

Sub StopTimer(Optional ByVal Dummy As Boolean)
    Call KillTimer(Application.hwnd, 0)
End Sub

Sub DO_NOT_USE_THIS_FUNCTION()
    Dim oUForm As UPrintWatcher
    On Error Resume Next
    If VBA.UserForms.Count = 0 Then Call StopTimer: Exit Sub
    For Each oUForm In VBA.UserForms
        If oUForm.Tag = "PrintWatcher" Then
            Call oUForm.TimerProc
        Else
            Call StopTimer
        Exit Sub
        End If
    Next
End Sub

Private Sub Auto_Close(Optional ByVal Dummy As Boolean)
    Call StopTimer
End Sub

If I find a way to Intercept and cancel PPT print events, I will post it here.

Hope this helps.