excel vba disable print screen

[joseso]

I need to unarchive the Print Screen function of a file.

The file I posted was the same one I found on the internet.
This code works on this file, but when trying to run in the 2013 version it gets in error.

Would anyone know how to solve it?

Thisworkbook:

[/COLOR]Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    UnsetKeyboardHook
End Sub


Private Sub Workbook_Deactivate()
 UnsetKeyboardHook
End Sub


Private Sub Workbook_Open()
    SetKeyboardHook
End Sub


[COLOR=#333333]

Modules:

[/COLOR]Option Explicit

Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long


Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)


Private Const WH_KEYBOARD_LL = &HD


Private Const WM_KEYDOWN = &H100
Private Const WM_SYSKEYDOWN = &H104


Private Const HC_ACTION = 0


Private Const VK_PRINTSCREEN = &H2C


Public Type KBDLLHOOKSTRUCT
    vkCode As Long
    scanCode As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type


Private hHook As Long


Public Function SetKeyboardHook() As Long


    If hHook = 0 Then
        hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, Application.Hinstance, 0)
        SetKeyboardHook = hHook
    End If


End Function


Public Sub UnsetKeyboardHook()


    Call UnhookWindowsHookEx(hHook)
    hHook = 0


End Sub


Private Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long


    Dim lpllkHookStruct As KBDLLHOOKSTRUCT


    If nCode = HC_ACTION Then
        Call CopyMemory(lpllkHookStruct, ByVal lParam, Len(lpllkHookStruct))
        
        If lpllkHookStruct.vkCode = VK_PRINTSCREEN Then
            LowLevelKeyboardProc = True
        Else
            LowLevelKeyboardProc = CallNextHookEx(hHook, nCode, wParam, lParam)
        End If
    Else
        LowLevelKeyboardProc = CallNextHookEx(hHook, nCode, wParam, lParam)
    End If
    
End Function


[COLOR=#333333]

 

[joseso]

It should work .. as a matter of fact, I 've just tested the code on a 32bit windows machine Excel 2007 and worked fine as expected.

I do not understand anything else.
I'll try to show how I'm doing. I put a Print from the VBA program. I just created a folder, created a module, and pasted all the code that you posted in the module.
At home I use Excel 2010 (32bit) and I use work 2013 (64bit)


[url = https://drive.google.com/open?id=1Od9vZ7b15WptAX-Or29-TWLyhxJXzPSu[/ img] [/ url]

A curious detail.
This code that I will post down here for example, in my work it did not work, already in my house it worked.
This code is divided into two parts in the worksheet.

ThisWorkbook:

Option Explicit
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    UnsetKeyboardHook
End Sub
 
Private Sub Workbook_Deactivate()
 UnsetKeyboardHook
End Sub
 
Private Sub Workbook_Open()
    SetKeyboardHook
End Sub

Module:

Option Explicit
 
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
 
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
 
Private Const WH_KEYBOARD_LL = &HD
 
Private Const WM_KEYDOWN = &H100
Private Const WM_SYSKEYDOWN = &H104
 
Private Const HC_ACTION = 0
 
Private Const VK_PRINTSCREEN = &H2C
 
Public Type KBDLLHOOKSTRUCT
    vkCode As Long
    scanCode As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type
 
Private hHook As Long
 
Public Function SetKeyboardHook() As Long
 
    If hHook = 0 Then
        hHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, Application.Hinstance, 0)
        SetKeyboardHook = hHook
    End If
 
End Function
 
Public Sub UnsetKeyboardHook()
 
    Call UnhookWindowsHookEx(hHook)
    hHook = 0
 
End Sub
 
Private Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
    Dim lpllkHookStruct As KBDLLHOOKSTRUCT
 
    If nCode = HC_ACTION Then
        Call CopyMemory(lpllkHookStruct, ByVal lParam, Len(lpllkHookStruct))
        
        If lpllkHookStruct.vkCode = VK_PRINTSCREEN Then
            LowLevelKeyboardProc = True
        Else
            LowLevelKeyboardProc = CallNextHookEx(hHook, nCode, wParam, lParam)
        End If
    Else
        LowLevelKeyboardProc = CallNextHookEx(hHook, nCode, wParam, lParam)
    End If
    
End Function

I put this code so that you can understand better what is going wrong when I try to put the code to work. Because this code only works in my house.

 

[Jaafar Tribak]

When you say the code "didn't work" what do you mean exactly ? Do you mean you get an error or does it just not capture the Print screen press ?

 

[joseso]

When you say the code "didn't work" what do you mean exactly ? Do you mean you get an error or does it just not capture the Print screen press ?

You are still capturing a screen print.

 

[Jaafar Tribak]

Try introducing a brieve delay when opening the workbook before setting the hook as follows :

Private Sub Workbook_Open()
    Application.OnTime Now + TimeSerial(0, 0, 2), "SetKeyboardHook"
End Sub

 

[joseso]

Try introducing a brieve delay when opening the workbook before setting the hook as follows :

Private Sub Workbook_Open()
    Application.OnTime Now + TimeSerial(0, 0, 2), "SetKeyboardHook"
End Sub

I tested at home with a 32 bit machine ... IT WORKED !!!!
I'll test tomorrow with the machines of the company. I hope it works too!
I'll give you a return tomorrow.

 

[Jaafar Tribak]

I tested at home with a 32 bit machine ... IT WORKED !!!!
I'll test tomorrow with the machines of the company. I hope it works too!
I'll give you a return tomorrow.

I would be very wary about installing a keyboard hook in excel in this fashion specially when the workbook is going to be used by different users as any unhandled error while the hook is installed would crash the application hence losing any unsaved work !

 

[joseso]

I would be very wary about installing a keyboard hook in excel in this fashion specially when the workbook is going to be used by different users as any unhandled error while the hook is installed would crash the application hence losing any unsaved work !

The workbook that will stay with them only have access to a refresh button. The rest had been blocked. There is no way to edit.
It will only be a spreadsheet that updates data from another workbook.

Tomorrow I confirm if it worked in the company

 

[joseso]

I would be very wary about installing a keyboard hook in excel in this fashion specially when the workbook is going to be used by different users as any unhandled error while the hook is installed would crash the application hence losing any unsaved work !

It did not work ... I do not know what can be, because only in the machines of the company does not work ... to help today have been updated to excel 2016.
I put the same code that worked at home, and keep copying.
Is it some configuration that does not let, can it be that?
The computer sector blocks access to your Windows settings, so this may be the problem.

 

[joseso]

I would be very wary about installing a keyboard hook in excel in this fashion specially when the workbook is going to be used by different users as any unhandled error while the hook is installed would crash the application hence losing any unsaved work !

jaafar,

Apparently there will be no solution to my case.
Even so I would like to thank you for your time in trying to help me.
Thank you so much.

 

[Jaafar Tribak]

jaafar,

Apparently there will be no solution to my case.
Even so I would like to thank you for your time in trying to help me.
Thank you so much.

You are welcome.

I'll post another code using a different approach hoping it will work .