Impression Multipage d'un UserForm

Version imprimable

23/09/2009, 21h11
Lufia

Impression Multipage d'un UserForm
Bonjour encore à vous tous!

J'ai un UserForm (name: frmPostMortem) comprenant un Multipage (name: Multipage1) qui comporte 2 page (name: Page1 et Page2).

À la toute fin du UserForme, j'ai un bouton Imprimer (name: btImprimer) auquel j'ai appliqué le code:
Code:

1 2 3 4 Private Sub btImprimer_Click() frmPostMortem.PrintForm End Sub
Toutefois, il n'imprime qu'une seule page de mon Multipage. Je sais que les UserForm ne sont pas vraiment géniaux pour l'impression, mais y a-t-il un moyen d'imprimer les deux pages de mon multipage (idéalement sur la même page physique)??

Merci à l'avance!!
23/09/2009, 21h17
ucfoutu

Bonjour,

ainsi que précisé dans ton aide en ligne :

Citation:

PrintForm imprime tous les objets et les images bitmap visibles de l'objet UserForm

Si tu veux imprimer chaque page :
1) rends-la visible à l'écran
2) imprime-la

2 pages ? ===>> 2 impressions.

Bonjour,

Une solution déclinée à partir d'un Tuto de Silkyroad ;) à lire :

http://silkyroad.developpez.com/VBA/UserForm/#LIII-E

Qui te crée dans ton classeur une feuille temporaire, y colle les 2 pages de ton usf, dimentionne, imprime et supprime la feuille temporaire. Code brut d'une appli perso à adapter ;)
(gestion rafraîchissement écran non traitée à ce niveau - le choix d'une page ou plus dépend de la taille des ton USF / lisibilité).

Déclenché par un bouton sur la page 0 de l'USF qui en compte 4, mais seules les pages 0 et 1 sont ciblées.

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
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, _
                                               ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Sub cmdImpfiche_Click()
Dim objFeuilPass As Worksheet
 
mulFicheOnglet.Value = 1
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
Sheets.Add.Name = "PassImp"
Set objFeuilPass = Sheets("PassImp")
objFeuilPass.Paste
With objFeuilPass.Shapes(1)
    .Top = 3
    .Left = 10
    .Height = 390
    .Width = 448
End With
mulFicheOnglet.Value = 1
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
objFeuilPass.Paste
With objFeuilPass.Shapes(2)
    .Top = 391
    .Left = 10
    .Height = 390
    .Width = 448
End With
With objFeuilPass.PageSetup
        .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 = "Blabla - " & gvstrIdent
        .CenterHeader = "DGS_WORKLIST - Impression Fiche Courante"
        .RightHeader = txtRappelInterloc
        .LeftFooter = "Selon Choix"
        .CenterFooter = "&D" & " - " & "&T"
        .RightFooter = "page " & "&P" & " sur " & "&N"
        .PrintErrors = 0
End With
objFeuilPass.PrintOut
Application.DisplayAlerts = False
objFeuilPass.Delete
Application.DisplayAlerts = True
Set objFeuilPass = Nothing
mulFicheOnglet.Value = 0
End Sub

cordialement,

Didier

24/09/2009, 17h27
Lufia

WOOOWWWWW!!!! C'est exactement ce qu'il me fallaist!!!! :) Il ne reste plus qu'à jouer avec quelques paramètre pour place mes images adéquatement et inscrire les bonnes en-tête et pied de page!

cette macro sera définitivement à conserver!
Un très gros merci à toi Didier!!!

Merci encore pour ce code, il est tout intéressant!!

J'ai parcontre quelques difficulté à l'adapter. En cours de route, j'ai du ajouter une 3e page dans mon multipage que je souhaiterais faire imprimer sur une 2e page physique. Je voudrait en fait avoir :
Page physique #1 contient: Page1 et Page2 du multipage
Page physique #2 contient: Page3 du multipage

Est-ce que les pages 0 et 1 sont les seules à pouvoir être ciblées? Puis-je me rendre à 3 pages?

Citation:

Envoyé par Ormonth

Déclenché par un bouton sur la page 0 de l'USF qui en compte 4, mais seules les pages 0 et 1 sont ciblées.

Voici le contenu de mon code présentement (pratiquement copié de celui que tu m'as fourni, avec mes paramètres) :
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 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) Private Sub btImprimer_Click() Dim objFeuilPass As Worksheet MultiPage1.Value = 1 keybd_event vbKeySnapshot, 1, 0&, 0& DoEvents Sheets.Add.Name = "PassImp" Set objFeuilPass = Sheets("PassImp") objFeuilPass.Paste With objFeuilPass.Shapes(1) .Top = 3 .Left = 35 .Height = 380 .Width = 458 End With MultiPage1.Value = 1 keybd_event vbKeySnapshot, 1, 0&, 0& DoEvents objFeuilPass.Paste With objFeuilPass.Shapes(2) .Top = 300 .Left = 35 .Height = 380 .Width = 458 End With With objFeuilPass.PageSetup .LeftMargin = Application.InchesToPoints(0.25) .RightMargin = Application.InchesToPoints(0.25) .TopMargin = Application.InchesToPoints(0.56) .BottomMargin = Application.InchesToPoints(0.53) .HeaderMargin = Application.InchesToPoints(0.32) .FooterMargin = Application.InchesToPoints(0.39) .LeftHeader = "Post Mortem d'arrêt machine" .CenterHeader = " " .RightHeader = "Équipement #" & cbxEquipement .LeftFooter = " " .CenterFooter = "&D" & "" .RightFooter = "page " & "&P" & " sur " & "&N" .PrintErrors = 0 End With objFeuilPass.PrintOut Application.DisplayAlerts = False objFeuilPass.Delete Application.DisplayAlerts = True Set objFeuilPass = Nothing MultiPage1.Value = 0 End Sub
Pour ajouter le printscreen d'une autre page, j'ai essayé d'inscrire, avant la ligne "With objFeuilPass.PageSetup":
Code:

1 2 3 4 5 6 7 8 9 10 MultiPage1.Value = 1 keybd_event vbKeySnapshot, 1, 0&, 0& DoEvents objFeuilPass.Paste With objFeuilPass.Shapes(3) .Top = 750 'Distance suffisante pour que l'image 3 soit sur la page 2 .Left = 35 .Height = 380 .Width = 458 End With
Les problèmes rencontrés:
- Il ne change pas de page dans le multipage avant de faire son printscreen
- Même s'il colle bien l'image prise dans la feuille "PassImp", à l'impression il n'imprime que la première page physique. Je ne vois pas quel paramètre changer pour lui dire d'imprimer toutes les pages (2 au total).

Je me considère encore comme débutante et bien que je commence à comprendre la logique de VBA, certains éléments m'échappent encore!
Merci à l'avance pour votre aide!!!
Geneviève

Bonjour,

Je n'ai pas décodé ton code, c'est bien de travailler un peu, je te donne la logique que j'emploierai et qui est OK chez moi...

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
Private Sub cmdImpfiche_Click()
Dim objFeuilPass As Worksheet
Dim objFeuilPass2 As Worksheet
 
 
mulFicheOnglet.Value = 1
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
Sheets.Add.Name = "PassImp"
Set objFeuilPass = Sheets("PassImp")
objFeuilPass.Paste
With objFeuilPass.Shapes(1)
    .Top = 3
    .Left = 10
    .Height = 390
    .Width = 448
End With
mulFicheOnglet.Value = 1
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
objFeuilPass.Paste
With objFeuilPass.Shapes(2)
    .Top = 391
    .Left = 10
    .Height = 390
    .Width = 448
End With
Sheets.Add.Name = "PassImp2"
Set objFeuilPass2 = Sheets("PassImp2")
mulFicheOnglet.Value = 2
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
objFeuilPass2.Paste
 
etc...
 
objFeuilPass.PrintOut
objFeuilPass2.PrintOut
 
etc...

Il suffit de créer une feuille à chaque fois que tu en as besoin ;)

cordialement,

Didier

Le plus gros de mon problème n'est pas tant de créer ma deuxième page physique comme de pouvoir faire un print screen de la 3e page de mon multipage.

Avec ton code, je me retrouve avec le résultat suivant:

Page physique #1 contient printscreen multipage page1 et printscreen multipage page 2
Page physique #2 contient printscreen multipage page 2 (alors que je souhaiterai qu'elle contiennent multipage page 3). :calim2:

Je crois que je ne comprend pas la logique dans le changement de page du multipage...

Dans ton code Didier, pour tous les printscreens à coller sur objFeuilPass tu utilises

Code:

mulFicheOnglet.Value = 1

Et pour le printscreen à coller sur objFeuilPass2 tu utilises

Code:

mulFicheOnglet.Value = 2

il me semblait que :

Code:

1
2
3
mulFicheOnglet.Value = 0  = Page1
mulFicheOnglet.Value = 1  = Page2
mulFicheOnglet.Value = 2  = Page3

Est-ce que je me trompe? Pourquoi ne suis-je pas capable de sélectionner la page 3 de mon multipage???

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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
Private Sub btImprimer_Click()
Dim objFeuilPass As Worksheet
Dim objFeuilPass2 As Worksheet
 
' Print screen de Multipage page 1
MultiPage1.Value = 1
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
 
' Ajout de la feuille PassImp
Sheets.Add.Name = "PassImp"
Set objFeuilPass = Sheets("PassImp")
 
' Copie et mise en forme de l'image
objFeuilPass.Paste
With objFeuilPass.Shapes(1)
    .Top = 3
    .Left = 35
    .Height = 380
    .Width = 458
End With
 
' Print screen de Multipage page 2
MultiPage1.Value = 1
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
 
' Copie et mise en forme de l'image
objFeuilPass.Paste
With objFeuilPass.Shapes(2)
    .Top = 300
    .Left = 35
    .Height = 380
    .Width = 458
End With
 
' Ajout de la feuille PassImp2
Sheets.Add.Name = "PassImp2"
Set objFeuilPass2 = Sheets("PassImp2")
' Print screen de Multipage page 3
MultiPage1.Value = 2
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
 
' Copie et mise en forme de l'image
objFeuilPass2.Paste
With objFeuilPass2.Shapes(1)
    .Top = 3
    .Left = 35
    .Height = 380
    .Width = 458
End With
' Ajustement des PageSetup
With objFeuilPass.PageSetup
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.56)
        .BottomMargin = Application.InchesToPoints(0.53)
        .HeaderMargin = Application.InchesToPoints(0.32)
        .FooterMargin = Application.InchesToPoints(0.39)
        .LeftHeader = "Post Mortem d'arrêt machine"
        .CenterHeader = " "
        .RightHeader = "Équipement #" & cbxEquipement
        .LeftFooter = " "
        .CenterFooter = "&D" & ""
        .RightFooter = "page " & "&P" & " sur " & "&N"
        .PrintErrors = 0
End With
 
With objFeuilPass2.PageSetup
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.56)
        .BottomMargin = Application.InchesToPoints(0.53)
        .HeaderMargin = Application.InchesToPoints(0.32)
        .FooterMargin = Application.InchesToPoints(0.39)
        .LeftHeader = "Post Mortem d'arrêt machine"
        .CenterHeader = " "
        .RightHeader = "Équipement #" & cbxEquipement
        .LeftFooter = " "
        .CenterFooter = "&D" & ""
        .RightFooter = "page " & "&P" & " sur " & "&N"
        .PrintErrors = 0
End With
 
objFeuilPass.PrintOut
objFeuilPass2.PrintOut
Application.DisplayAlerts = False
objFeuilPass.Delete
objFeuilPass2.Delete
Application.DisplayAlerts = True
Set objFeuilPass = Nothing
Set objFeuilPass2 = Nothing
MultiPage1.Value = 0
 
End Sub

Merci encore pour votre aide :ccool:

Bonjour,

Effectivement, trop de précipitation, j’ai mis le code brut, mais dans mon appli, j’ai une « Private Sub mulFicheOnglet_Change() » qui appelle des « InitPage xxx », xxx étant le nom de l’onglet voulu et qui entre autres assure la temporisation nécessaire..et mon test rapide fonctionnait chez moi où le rafraîchissement n'est pas traité à ce stade...

J’ai isolé l’USF hors projet, et ai adapté la macro à cette « solitude ».
Tu retrouves une logique d’index normale et un résultat conforme..;)

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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
Private Sub cmdImpfiche_Click()
Dim objFeuilPass As Worksheet
Dim objFeuilPass2 As Worksheet
 
mulFicheOnglet.Value = 0
Me.Repaint
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
Sheets.Add.Name = "PassImp"
Set objFeuilPass = Sheets("PassImp")
objFeuilPass.Paste
With objFeuilPass.Shapes(1)
    .Top = 3
    .Left = 10
    .Height = 390
    .Width = 448
End With
mulFicheOnglet.Value = 1
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
Sheets.Add.Name = "PassImp2"
Set objFeuilPass2 = Sheets("PassImp2")
mulFicheOnglet.Value = 2
Me.Repaint
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
objFeuilPass2.Paste
With objFeuilPass2.Shapes(1)
    .Top = 3
    .Left = 10
    .Height = 390
    .Width = 448
End With
 
End 'pour les tests, retirer ensuite mettre imp pdf pour économie si besoin.
 
With objFeuilPass.PageSetup
        .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"
        .RightHeader = txtRappelInterloc
        .LeftFooter = "Le texte Voulu"
        .CenterFooter = "&D" & " - " & "&T"
        .RightFooter = "page " & "&P" & " sur " & "&N"
        .PrintTitleRows = "$1:$1"
        .PrintErrors = 0
End With
With objFeuilPass2.PageSetup
        .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 xxx "
        .RightHeader = txtRappelInterloc
        .LeftFooter = "Le texte Voulu"
        .CenterFooter = "&D" & " - " & "&T"
        .RightFooter = "page " & "&P" & " sur " & "&N"
        .PrintTitleRows = "$1:$1"
        .PrintErrors = 0
End With
objFeuilPass.PrintOut
objFeuilPass2.PrintOut
Application.DisplayAlerts = False
objFeuilPass.Delete
objFeuilPass2.Delete
Application.DisplayAlerts = True
Set objFeuilPass = Nothing
Set objFeuilPass2 = Nothing
mulFicheOnglet.Value = 0
End Sub

Attention au end pour le test, effacer les feuilles temporaires si relance..

vois la méthode Repaint .../...

Citation:

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.

cordialement,

Didier

Bonjour!

Ça marche à merveille! La seule chose que j'ai changé est qu'au lieu d'ajouter une deuxième feuille, je change la valeur .Top de l'image 3 pour qu'elle arrive sur la 2e page.
Le problème avec l'ajout d'une deuxième page est qu'à l'impression dans un fichier pdf, il génère un pdf pour chacune des commandes ce qui n'était pas souhaitable.

Code:

1
2
objFeuilPass.PrintOut
objFeuilPass2.PrintOut

En inscrivant

Code:

1
2
3
4
5
6
With objFeuilPass.Shapes(3)
    .Top = 717
    .Left = 40
    .Height = 390
    .Width = 448
End With

je m'assure que l'image 3 est sur la 2e page et que tout s'imprime comme il se doit.

Voici donc mon code final (J'en suis bien fière!!!)

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
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)
Private Sub btImprimer_Click()
Dim objFeuilPass As Worksheet
 
 
MultiPage1.Value = 0
Me.Repaint
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
Sheets.Add.Name = "PassImp"
Set objFeuilPass = Sheets("PassImp")
objFeuilPass.Paste
With objFeuilPass.Shapes(1)
    .Top = 3
    .Left = 40
    .Height = 390
    .Width = 448
End With
MultiPage1.Value = 1
Me.Repaint
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
objFeuilPass.Paste
With objFeuilPass.Shapes(2)
    .Top = 250
    .Left = 40
    .Height = 390
    .Width = 448
End With
MultiPage1.Value = 2
Me.Repaint
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
objFeuilPass.Paste
With objFeuilPass.Shapes(3)
    .Top = 717
    .Left = 40
    .Height = 390
    .Width = 448
End With
With objFeuilPass.PageSetup
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.53)
        .HeaderMargin = Application.InchesToPoints(0.32)
        .FooterMargin = Application.InchesToPoints(0.39)
        .LeftHeader = "Post Mortem d'arrêt machine"
        .CenterHeader = " "
        .RightHeader = "Équipement #" & cbxEquipement
        .LeftFooter = " "
        .CenterFooter = "&D" & ""
        .RightFooter = "page " & "&P" & " sur " & "&N"
        .PrintErrors = 0
End With
 
objFeuilPass.PrintOut
Application.DisplayAlerts = False
objFeuilPass.Delete
Application.DisplayAlerts = True
Set objFeuilPass = Nothing
MultiPage1.Value = 0
 
 
End Sub

Merci beaucoup de votre support! J'apprend un peu plus chaque jour grace à vous! :ccool:
Geneviève