Imprimer toutes les pages d'un USF Multipages

Bonjour,

Testé sous 2000, 2003 & 2007.

Voici une macro permettant d’imprimer toutes les pages / Onglets d’un Userform multipage.
Pour vos tests, mettre l’imprimante par défaut en pdf est intéressant.

Décliné à partir d’un tuto de Silkyraod :
http://silkyroad.developpez.com/VBA/UserForm/#LIII-E

L’USF ici comporte 3 pages avec le bouton d’impression sur la première (cf image).

Attention : Si vous employez des utilitaires de copie d’écran, ceux-ci peuvent interférer avec le système Windows et entraîneront un plantage => les désactiver si c’est le cas…

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
Option Explicit
 
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, _
                                               ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
' Fait appel à une API qui permet de simuler les frappes au clavier;
'bscan qui permet d'utiliser certaines touches spéciales nous intéresse particulièrement ici,
'si sa valeur est 1, on fait référence à la copie d'écran,
'si elle est à 0, on fait référence à la forme active => ce qui est le cas ici.
 
Private Sub cmdImpfiche_Click()
Dim objFeuilPass As Worksheet
 
mulFicheOnglet.Value = 0 ' on donne le focus à l'onglet voulu, 1ère page = 0
Me.Repaint 'La méthode Repaint est utile si le contenu ou l'aspect d'un objet change
        'de façon significative, et si vous ne voulez pas attendre que le système redessine automatiquement la zone.
        'indispensable ici, sinon l'USF n'est pas rafraîchi assez vite.
keybd_event vbKeySnapshot, 1, 0&, 0& ' capture de l'USF
DoEvents 'permet de donner le temps à l'image d'être chargée / mémoire
Sheets.Add.Name = "PassImp"  'on ajoute une feuille temporaire au classeur
Set objFeuilPass = Sheets("PassImp")
objFeuilPass.Paste  ' on copie notre Snapshot
With objFeuilPass.Shapes(1)  'on redimetionne l'image à volonté
    .Top = 3
    .Left = 10
    .Height = 390
    .Width = 448
End With
mulFicheOnglet.Value = 1 'on passe à l'onglet suivant...
Me.Repaint
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
objFeuilPass.Paste
With objFeuilPass.Shapes(2)
    .Top = 391
    .Left = 10
    .Height = 390
    .Width = 448
End With
mulFicheOnglet.Value = 2 ' etc...
Me.Repaint
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
objFeuilPass.Paste
With objFeuilPass.Shapes(3)
    .Top = 815
    .Left = 10
    .Height = 390
    .Width = 448
End With
With objFeuilPass.PageSetup 'on met en forme nos paramètres d'impression
        .LeftMargin = Application.InchesToPoints(0.35)
        .RightMargin = Application.InchesToPoints(0.35)
        .TopMargin = Application.InchesToPoints(0.56)
        .BottomMargin = Application.InchesToPoints(0.53)
        .HeaderMargin = Application.InchesToPoints(0.32)
        .FooterMargin = Application.InchesToPoints(0.39)
        .LeftHeader = "Fiche Cli - " & "Toto"
        .CenterHeader = "DGS_WORKLIST - Impression Fiche Courante- onglet 1&2"
        .RightHeader = "ce qu'on veut"
        .LeftFooter = "Le texte Voulu"
        .CenterFooter = "&D" & " - " & "&T"
        .RightFooter = "page " & "&P" & " sur " & "&N"
        .PrintErrors = 0 'à invalider si avant 2003
End With
Stop
objFeuilPass.PrintOut  'on lance l'impression / imprimante par défaut
Application.DisplayAlerts = False
objFeuilPass.Delete  'on supprime les feuilles temporaires
Application.DisplayAlerts = True
Set objFeuilPass = Nothing
mulFicheOnglet.Value = 0
End Sub

http://stock.dg-solutions.fr//images/ongletx.jpg

cordialement,

Didier