Plus d'aperçu avant impression ..

Bonjour Olitoto,

Une proc publiée ici même par Alain Cros

Private Declare Function SetWindowsHookEx& _
Lib "user32" Alias "SetWindowsHookExA" _
(ByVal idHook&, ByVal lpfn&, ByVal hmod&, ByVal dwThreadId&)

Private Declare Function GetCurrentThreadId& _
Lib "kernel32" _
()

Private Declare Function UnhookWindowsHookEx& _
Lib "user32" _
(ByVal hHook&)

Private Declare Function GetClassName& Lib "user32" _
Alias "GetClassNameA" (ByVal hWnd&, ByVal lpClassName$, ByVal
nMaxCount&)

Private Declare Function GetDlgCtrlID& Lib "user32" _
(ByVal hWnd&)

Private Declare Function SetWindowLong& _
Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)

Private Declare Function CallWindowProc& _
Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc&, ByVal hWnd&, ByVal Msg&, ByVal wParam&, ByVal
lParam&)

Private LeHook&, OldWinProc&

Private Function NomDeClass$(hWnd&)
NomDeClass = Space$(20&)
NomDeClass = Left$(NomDeClass, GetClassName(hWnd, NomDeClass, 20&))
End Function

Sub ApercuAvantImpression()
Const WH_CBT& = &H5
LeHook = SetWindowsHookEx(WH_CBT, AddressOf HookMsgb, 0&,
GetCurrentThreadId)
Application.Dialogs(xlDialogPrintPreview).Show
UnhookWindowsHookEx LeHook
End Sub

Private Function ImpProc&(ByVal hWnd&, ByVal Msg&, ByVal wParam&, ByVal
lParam&)
Const WM_DESTROY& = &H2, GWL_WNDPROC& = -4&, BM_SETSTATE& = &HF3
If Msg = WM_DESTROY Then
SetWindowLong wParam, GWL_WNDPROC, OldWinProc
End If
If Msg = BM_SETSTATE Then
If wParam = 1& Then
MsgBox "Impossible d'imprimer.", vbCritical, "Spécial MichDenis"
End If
Exit Function
End If
ImpProc = CallWindowProc(OldWinProc, hWnd, Msg, wParam, lParam)
End Function

Private Function HookMsgb&(ByVal lMsg&, ByVal wParam&, ByRef lParam&)
Const HCBT_ACTIVATE& = 5&, GWL_WNDPROC& = -4&, HCBT_SETFOCUS& = 9&
If lMsg = HCBT_SETFOCUS Then
If NomDeClass(wParam) = "Button" Then
If GetDlgCtrlID(wParam) = 3& Then
UnhookWindowsHookEx LeHook
OldWinProc = SetWindowLong(wParam, GWL_WNDPROC, AddressOf
ImpProc)
End If
End If
End If
End Function

---------------------------------------------------------

ChrisV


"olitoto" <toto@wanadoo.fr> a écrit dans le message de news:
uvRuJEE$FHA.2676@TK2MSFTNGP10.phx.gbl...

Bonjour à tous,

J'ai interdit l'impression d'une feuille avec :

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Cancel = False
MsgBox "Impression interdite", vbOKOnly
Cancel = True
End Sub

Ca, c'est bon ,ça roule,

Ce qui m'embête , c'est que ça désactive aussi la possibilité de faire un
aperçu ..........

Si qq peut me donne run solution pour laisser l'aperçu actif, je suis
preneur !

Merci à tous

Olivier

Merci ChrisV, mais je ne sais pas dans quel module recopier ce code.

Si je le met dans "thiswoorbook" ça ne marche pas et l'impression peut
se faire ....


Olivier

Re,

Arghhh... je viens à l'instant de tester (sous Excel 2003), il manque
effectivement quelques petites choses...
Donc, on reprends...

Dans la feuille de code de ThisWorkbook:
---------------
Private Sub Workbook_Activate()
'par leur index
With Application.CommandBars(3)
.Controls(6).Enabled = False
.Controls(7).OnAction = "ApercuAvantImpression"
End With
'ou par leur caption
With Application.CommandBars(1).Controls(1)
.Controls("Imprimer...").Enabled = False
End With
Application.OnKey "^p", ""
End Sub

Private Sub Workbook_Deactivate()
With Application.CommandBars(3)
.Controls(6).Enabled = True
.Controls(7).Reset
End With
With Application.CommandBars(1).Controls(1)
.Controls("Imprimer...").Enabled = True
End With
Application.OnKey "^p"
End Sub

Dans un module standard:
---------------
'Alain Cros
Private Declare Function SetWindowsHookEx& _
Lib "user32" Alias "SetWindowsHookExA" _
(ByVal idHook&, ByVal lpfn&, ByVal hmod&, _
ByVal dwThreadId&)

Private Declare Function GetCurrentThreadId& _
Lib "kernel32" ()

Private Declare Function UnhookWindowsHookEx& _
Lib "user32" (ByVal hHook&)

Private Declare Function GetClassName& Lib "user32" _
Alias "GetClassNameA" (ByVal hWnd&, _
ByVal lpClassName$, ByVal nMaxCount&)

Private Declare Function GetDlgCtrlID& Lib "user32" _
(ByVal hWnd&)

Private Declare Function SetWindowLong& _
Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)

Private Declare Function CallWindowProc& _
Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc&, ByVal hWnd&, ByVal Msg&, _
ByVal wParam&, ByVal lParam&)

Private LeHook&, OldWinProc&

Private Function NomDeClass$(hWnd&)
NomDeClass = Space$(20&)
NomDeClass = Left$(NomDeClass, GetClassName(hWnd, _
NomDeClass, 20&))
End Function

Sub ApercuAvantImpression()
Const WH_CBT& = &H5
LeHook = SetWindowsHookEx(WH_CBT, AddressOf HookMsgb, _
0&, GetCurrentThreadId)
Application.Dialogs(xlDialogPrintPreview).Show
UnhookWindowsHookEx LeHook
End Sub


Private Function ImpProc&(ByVal hWnd&, ByVal Msg&, _
ByVal wParam&, ByVal lParam&)
Const WM_DESTROY& = &H2, GWL_WNDPROC& = -4&, _
BM_SETSTATE& = &HF3
If Msg = WM_DESTROY Then
SetWindowLong wParam, GWL_WNDPROC, OldWinProc
End If
If Msg = BM_SETSTATE Then
If wParam = 1& Then
MsgBox "Impression désactivée !", vbCritical, _
"ERREUR..."
End If
Exit Function
End If
ImpProc = CallWindowProc(OldWinProc, hWnd, Msg, wParam, _
lParam)
End Function


Private Function HookMsgb&(ByVal lMsg&, ByVal wParam&, _
ByRef lParam&)
Const HCBT_ACTIVATE& = 5&, GWL_WNDPROC& = -4&, _
HCBT_SETFOCUS& = 9&
If lMsg = HCBT_SETFOCUS Then
If NomDeClass(wParam) = "Button" Then
If GetDlgCtrlID(wParam) = 3& Then
UnhookWindowsHookEx LeHook
OldWinProc = SetWindowLong(wParam, _
GWL_WNDPROC, _
AddressOf ImpProc)
End If
End If
End If
End Function


ChrisV


"olitoto" <qsqsd@qsqd.fr> a écrit dans le message de news:
ehJKvLM$FHA.1676@TK2MSFTNGP09.phx.gbl...

Merci ChrisV, mais je ne sais pas dans quel module recopier ce code.

Si je le met dans "thiswoorbook" ça ne marche pas et l'impression peut se
faire ....


Olivier