Bouton ZOOM en mode Apercu avant Impression

[BOUCHEZ JD]

Bonjour au forum.

Quelqu'un sait il comment, en VBA, on active le Bouton ZOOM en mode "Apercu avant Impression" pour que la page soit au maxi.
(On peut aussi cliquer sur la page pour que le mode zoom change)

Grand merci d'avance

 

[PMO2]

Re : Bouton ZOOM en mode Apercu avant Impression

Bonjour,

Voici une solution bien compliquée mais qui a le mérite de faire.
J'utilise pour cela les APIs, une qui déclenche un timer et une autre qui l'arrête,
une qui déplace le curseur et une qui simule le clic souris.

Code à copier dans un module standard

'/// APIs ///
Private Declare Sub mouse_event Lib "user32" _
  (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, _
   ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Function SetCursorPos& Lib "user32" _
  (ByVal x As Long, ByVal y As Long)
Private Declare Function SetTimer& Lib "user32" _
  (ByVal hwnd As Long, ByVal nIDEvent As Long, _
  ByVal uElapse As Long, ByVal lpTimerFunc As Long)
Private Declare Function KillTimer& Lib "user32" _
  (ByVal hwnd As Long, ByVal nIDEvent As Long)
'/// Constantes APIs ///
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
'/// Variables de portée module ///
Private OnTimer As Long
Private WidthCenter As Long
'___________________________
Sub ZoomPrintPreview()
Dim EtatWindow&
If ActiveSheet.UsedRange.Address = "$A$1" And [a1] = "" Then
  MsgBox "On ne trouve rien à imprimer."
  Exit Sub
End If
EtatWindow& = Application.WindowState
Application.WindowState = xlMaximized
WidthCenter = CLng(Application.Width / 1.55)
OnTimer& = 0
Call RunTimer(Delai:=0)
Application.Dialogs(xlDialogPrintPreview).Show
Application.WindowState = EtatWindow&
End Sub
'___________________________
Private Sub RunTimer(Delai&)
If OnTimer& > 0 Then OffTimer
OnTimer& = SetTimer(0, 0, ByVal Delai&, AddressOf SimuleClicSouris)
End Sub
'___________________________
Private Sub OffTimer()
If OnTimer& > 0 Then
  OnTimer& = KillTimer(0&, OnTimer&)
  OnTimer& = 0
End If
End Sub
'___________________________
Private Sub SimuleClicSouris()
SetCursorPos 37, 100
mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0&, 0&, 0, 0
SetCursorPos WidthCenter, 100
mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0&, 0&, 0, 0
Call OffTimer
End Sub

Faites un essai en lançant la Sub ZoomPrintPreview à partir d'une feuille CONTENANT quelque chose à imprimer.

Cordialement.

PMO
Patrick Morange