Imprimer plusieurs pages d'un multipage

**MelkInarian** · 12/12/2017, 14h29

Bonjour,
je souhaite imprimer les quatre pages d'un multipage.
sur ce forum et la FAQ j'ai trouvé presque tout ce dont j'avais besoin.
Mon problème est que lors des impressions j'ai des zones blanches baladeuses (les textboxes en sont absentes - 2 impressions consécutives ne donnent pas la même chose).
Il arrive parfois que tout y soit mais c'est très rare.
voici le code utilisé:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
97
98
99
100
101
102
103
104
 
Private Declare Sub keybd_event Lib "user32" ( _
ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)   ' voir plus bas ; impression d'écran
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long            ' voir plus bas ; je commence par vider le presse papier
Private Declare Function CloseClipboard Lib "user32" () As Long                             ' voir plus bas ; je commence par vider le presse papier
Private Declare Function EmptyClipboard Lib "user32" () As Long                             ' voir plus bas ; je commence par vider le presse papier
 
 
Private Sub cmdImpfiche_Click()
    Dim objFeuilProv As Worksheet
    Dim PJ, Cel, Fin, P As String                                   ' Prénom - Nom du PJ ; Adresse de cellule "A1" ; Adresse de cellule de fin "N152" ; N° de page "P1"
    Dim i, Nb As Integer                                            ' i : Compteur de boucle ; Nb : Nombre de feuilles de calcul dans ce classeur
    Dim DureePause, Start, Finish, TotalTime
 
    Nb = ThisWorkbook.Worksheets.Count                              ' Je récupère le nombre de feuilles de calcul avant tout traitement
 
    ' je commence par vider le presse papier, pour éviter des collages intempestifs
                                                                    'L'objet ClipBoard n'existant pas en VBA, il faut utiliser les fonctions de l'API Windows :
                                                                    'Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
                                                                    'Private Declare Function CloseClipboard Lib "user32" () As Long
                                                                    'Private Declare Function EmptyClipboard Lib "user32" () As Long
    OpenClipboard 0                                                 ' Ouvre le presse papier
    EmptyClipboard                                                  ' Vide  le presse papier
    CloseClipboard                                                  ' Ferme le presse papier
    ' le presse papier est vide
 
    For i = 1 To Nb 'recherche d'une feuille nommée "ProvImp" pour le cas ou il y aurait eu un problème la fois précédente et la feuille provisoire n'aurait pas été supprimée
        If ThisWorkbook.Worksheets(i).Name = "ProvImp" Then         ' Si une feuille nommée "ProvImp" est trouvée
            Application.DisplayAlerts = False                       ' Empêche l'affichage d'une boite d'alerte
            ThisWorkbook.Worksheets(i).Delete                       ' Si une feuille nommée "ProvImp" est présente on la supprime
            Application.DisplayAlerts = True                        ' Rétablit l'affichage des boites d'alerte
            Exit For                                                ' Permet de sortir de la boucle "For" quand la condition remplie à été traitée
        End If
    Next i
 
    Sheets.Add.Name = "ProvImp"                                     ' Ajoute un feuille de calcul provisoire nommée "ProvImp" 'Provisoire pour impression'
    Set objFeuilProv = Sheets("ProvImp")                            ' Définit un objet correpondant a la feuille de calcul provisoire nommée "ProvImp"
 
    For i = 0 To 3                                                  ' pour chacune des 4 pages (0 à 3) du controle 'MultiPage1'
        MultiPage1.Value = i                                        ' la 1ère page du multipage à le .value = 0 ; la seconde le .value = 1 ...
        Me.Repaint                                                  ' Repaint, méthode, Met à jour l'affichage en redessinant la feuille ou la page. 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.
        keybd_event vbKeySnapshot, 1, 0&, 0&                        ' évenement clavier (impression d'écran : récupérer une partie de ma capture d'écran keybd_event / vbKeySnapshot )
 
        DureePause = 1.5                                              ' définit une durée de pause en secondes, ici 1/2s
        Start = Timer                                               ' définit le moment du départ.
        Do While Timer < Start + DureePause                         ' tant que le timer n'est pas arrivé à moment du départ plus DureePause
                DoEvents                                            ' Arrête momentanément l'exécution afin que le système d'exploitation puisse traiter d'autres événements.
        Loop                                                        ' boucle
 
        Select Case i
            Case 0: Cel = "A1"                                    ' si i=0 alors la cellule de destination de la 1ère image sera "A1"
                    Fin = "N40"                                    ' si i=0 alors la cellule de fin de la 1ère image sera "S40    "
                    P = "P1"                                        ' si i=0 alors c'est la page 1
            Case 1: Cel = "A43"                                     ' si i=1 alors la cellule de destination de la 1ère image sera "A43"
                    Fin = "N81"                                    ' si i=0 alors la cellule de fin de la 1ère image sera "S82"
                    P = "P2"                                        ' si i=1 alors c'est la page 2
            Case 2: Cel = "A85"                                     ' si i=2 alors la cellule de destination de la 1ère image sera "A83"
                    Fin = "N124"                                     ' si i=0 alors la cellule de fin de la 1ère image sera "S122"
                    P = "P3"                                        ' si i=2 alors c'est la page 3
            Case 3: Cel = "A127"                                      ' si i=3 alors la cellule de destination de la 1ère image sera "A123"
                    Fin = "N166"                                     ' si i=0 alors la cellule de fin de la 1ère image sera "S162"
                    P = "P4"                                        ' si i=3 alors c'est la page 4
             Case Else: MsgBox "Problème avec le n° de page..."      ' Mais que ce passe-t'il ?
        End Select
 
        objFeuilProv.Paste Destination:=objFeuilProv.Range(Cel & ":" & Fin) ' La Méthode Worksheet.Paste colle le contenu du Presse-papiers dans la feuille - ici une image dans la feuille provisoire : l'objet objFeuilProv
        objFeuilProv.Shapes(i + 1).Name = P                            ' L'objet est nommé  "f(case) plus haut"
    Next i
 
    PJ = TB_Prenom.Value & " " & CB_NomPJ.Value                     ' affecte le prénom et nom du PJ à la variable PJ
 
    ActivePrinter = "PDFCreator sur Ne00:"                          ' Définit l'imprimante active comme étant : PDFCreator
 
    With objFeuilProv.PageSetup
            .LeftMargin = Application.CentimetersToPoints(0.45)     ' Renvoie ou définit la largeur de la marge de gauche, en points - (ici transformée en cm par 'CentimetersToPoints')
            .RightMargin = Application.CentimetersToPoints(0.5)     ' Renvoie ou définit la largeur de la marge de droite, exprimée en points -  (ici transformée en cm par 'CentimetersToPoints')
            .TopMargin = Application.CentimetersToPoints(1.2)       ' Cette propriété renvoie ou définit la taille de la marge supérieure, exprimée en points -  (ici transformée en cm par 'CentimetersToPoints')
            .BottomMargin = Application.CentimetersToPoints(0.5)    ' Cette propriété renvoie ou définit la taille de la marge du bas, en points (ici transformée en cm par 'CentimetersToPoints')
            .HeaderMargin = Application.CentimetersToPoints(0.25)   ' Cette propriété renvoie ou définit la distance entre le haut de la page à l'en-tête, exprimée en points - (ici transformée en cm par 'CentimetersToPoints')
            .FooterMargin = Application.CentimetersToPoints(0.25)   ' Cette propriété renvoie ou définit la distance à partir du bas de la page au pied de page, exprimée en points  -  (ici transformée en cm par 'CentimetersToPoints')
 
            .LeftHeader = PJ                                        ' Renvoie ou définit l’alignement du texte dans l’en-tête gauche d’un classeur ou d’une section - Nom et prénom du PJ dans l'entête à gauche
            .CenterHeader = " "                                     ' Centre aligne les informations d'en-tête de l'objet PageSetup - un vide dans l'entête au centre
            .RightHeader = " "                                      ' Cette propriété renvoie ou définit la partie droite de l'en-tête - un vide dans l'entête à droite
            .LeftFooter = " "                                       ' Renvoie ou définit l’alignement du texte dans le pied de page gauche d’un classeur ou d’une section
            .CenterFooter = "&D" & ""                               ' Centre le contenu du pied de page dans l'objet PageSetup - La date dans le pied de page au centre
            .RightFooter = "page " & "&P" & " sur " & "&N"          ' Cette propriété renvoie ou définit la distance (en points) entre le bord droit de la page et la bordure droite du pied de page - N° de page / Nb pages dans le pied de page à droite
 
            .PrintErrors = 0                                        ' Définit ou renvoie une constante XlPrintErrors indiquant le type d'erreur d'impression affiché. Cette fonctionnalité permet aux utilisateurs de supprimer l'affichage des valeurs d'erreur lors de l'impression d'une feuille de calcul. | (ici 0, xlPrintErrorsDisplayed, Toutes les erreurs d'impression s'affichent.)
            .Orientation = xlLandscape                              ' Renvoie ou définit une valeur XlPageOrientation qui représente le mode d’impression en Portrait ou Paysage. - xlLandscape = Mode Paysage
            .Zoom = 88                                              ' Cette propriété renvoie ou définit une valeur de type Variant qui représente un pourcentage (compris entre 10 et 400 pour cent utilisé) par lequel Microsoft Excel pour une mettre à l'échelle de la feuille de calcul pour l'impression.
            .PaperSize = xlPaperA4                                  ' Renvoie ou définit la taille du papier. Type de données XlPaperSize - xlPaperA4 = A4 (21 x 29,7 cm)
            .CenterVertically = True                                ' True si la feuille est centrée verticalement sur la page lors de son impression.
    End With
 
    objFeuilProv.PrintOut                                           ' lance l'impression de la feuille "ProvImp"
 
    Application.DisplayAlerts = False                               ' Empêche l'affichage d'une boite d'alerte
    objFeuilProv.Delete                                             ' Supprime l'objet objFeuilProv
    Application.DisplayAlerts = True                                ' Rétablit l'affichage des boites d'alerte
    Set objFeuilProv = Nothing                                      ' ça JE N'AI PAS TROUVé à QUOI ça SERT
    MultiPage1.Value = 0                                            ' Définit la 1ère page du MultiPages comme page affichée.
 
End Sub

Je l'ai abondamment commenté car j'ai la mémoire qui flanche!
j'ai mis en place un timer, un temps ça avait l'air mieux mais plus maintenant.
j'ai l'ai fait varier de 0,5s à 3s et ce n'est pas mieux.
à un moment je me suis rendu compte que si je déplaçait systématiquement mon UserForm (mais uniquement dans la plage de cellules d'une feuille de calcul) c'était mieux mais c'est aléatoire.
Quelqu'un pourrait il m'expliquer le fond du problème et m'aider à le résoudre?
Merci

**patricktoulon** · 12/12/2017, 15h47

je supose que meme avec un timer tu te retrouve pazrfois avec le meme page voir une erreur est declenché car pas de bitmap dans le clipboard
c'est bien ca ??
d'autant plus que tu relache pas la touche snapshot
ca +cela = gros foutoir

**MelkInarian** · 12/12/2017, 16h10

Merci pour la réponse,
j'ai de temps à autres des plantages c'est vrai mais pas très fréquents et je n'avais pas fait le lien.

d'autant plus que tu relache pas la touche snapshot

Que dois-je faire pour "relâcher la touche snapshot"?
Car, comme je le disait précédemment, j'ai adapté des bouts de code trouvés ici et là pour bâtir ma fonction.
Je ne suis pas un spécialiste.
Merci

**patricktoulon** · 12/12/2017, 16h58

re
1° comment capturer avec la touche snapshot (impr/imprecran)
la c'est pas de ta faute dans la faq ce n'est pas precisé pourtant tres important pour la suite

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
'capture 
keybd_event &H2C, 1, 0, 0  ' on appuie 
keybd_event &H2C, 1, &H2, 0   'et  on relache la touche snapshot

ensuite ton timer a sacré timer

il depanne bien celui la oui mais non car chaque pc a sa vitesse (UC/memoire)
donc selon ce que ton pc fait tourner en arriere plan et sa capacité il peut suffire ou non
ca non plus c'est pas de ta faute ca n'est pas bien expliqué dans les faq je l'explique dans certaines de mes contributions a ce sujet d'ailleurs

alors en fait ce timer il sert a quoi selon toi ?
et bien tout simplement a attendre que l'execution des touches envoie les informations dans le clipboard(le bitmap)(cliché de la fentre ou ecran)

alors l'idée serait de fair un do loop et interoger le clipboard si il contient un bitmap a oui cela serait super oui mais comment????
tout simplement avec l'api qui est faite pour ca

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Private Declare Function IsClipboardFormatAvailable Lib "User32" (ByVal wFormat As Integer) As Long

ah!!!.. ben chouette alors

donc notre boucle d'attente serait du genre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 Do: DoEvents: hPicAvail = IsClipboardFormatAvailable(2): Loop While hPicAvail = 0

bon ben voila avec tout le reste que tu a a peu pres compris (si ce n'est que ton clipboard doit etre vider a chaque changement de page dans le multipage) on a de quoi

le fait est aussi que parfois le value du multipage n'est pas a jours

un tout petit do loop sur son etat fera l'affaire

alors voila j'ai fait un test
j'ai pris un userform comme ca vite fait
je lui ai mi un multipage avec 4 page
j'ai mis un bouton avec un nom different pour bien verifier sur les captures

et j'ai arranger toutes la premiere partie de ton code et m'en suis servi pour coller les 4 capture des 4 pages de ton multipage dans le sheets

allez allons y
je te laisse analyser tout ca tranquillement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Declare Sub keybd_event Lib "User32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)                                   ' voir plus bas ; impression d'écran
Private Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long            ' voir plus bas ; je commence par vider le presse papier
Private Declare Function CloseClipboard Lib "User32" () As Long                             ' voir plus bas ; je commence par vider le presse papier
Private Declare Function EmptyClipboard Lib "User32" () As Long                             ' voir plus bas ; je commence par vider le presse papier
Private Declare Function IsClipboardFormatAvailable Lib "User32" (ByVal wFormat As Integer) As Long
 
Private Sub CommandButton1_Click()
    Dim objFeuilProv As Worksheet
    Dim PJ, Cel, Fin, P As String                                   ' Prénom - Nom du PJ ; Adresse de cellule "A1" ; Adresse de cellule de fin "N152" ; N° de page "P1"
    Dim i, Nb As Integer                                            ' i : Compteur de boucle ; Nb : Nombre de feuilles de calcul dans ce classeur
    Dim DureePause, Start, Finish, TotalTime
    Nb = ThisWorkbook.Worksheets.Count                              ' Je récupère le nombre de feuilles de calcul avant tout traitement
    ' je commence par vider le presse papier, pour éviter des collages intempestifs
    'L'objet ClipBoard n'existant pas en VBA, il faut utiliser les fonctions de l'API Windows :
    'Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    'Private Declare Function CloseClipboard Lib "user32" () As Long
    'Private Declare Function EmptyClipboard Lib "user32" () As Long
    ' le presse papier est vide
    Application.DisplayAlerts = False
    For Each sh In ThisWorkbook.Worksheets    '
        If sh.Name = "provimp" Then sh.Delete
    Next
    Set sh = Sheets.Add(After:=Sheets(Sheets.Count)): sh.Name = "provimp"
    Application.DisplayAlerts = True
    For i = 0 To 3                                                  ' pour chacune des 4 pages (0 à 3) du controle 'MultiPage1'
        MultiPage1.Value = i                                        ' la 1ère page du multipage à le .value = 0 ; la seconde le .value = 1 ...
clipboardempty
 
        Do: DoEvents: Loop Until MultiPage1.Value = i
        Me.Caption = "Page" & i + 1
        keybd_event vbKeySnapshot, 1, 0&, 0&  'on apuie                      ' évenement clavier (impression d'écran : récupérer une partie de ma capture d'écran keybd_event / vbKeySnapshot )
        keybd_event vbKeySnapshot, 1, &H2, 0&    'on relache
        Do: DoEvents: hPicAvail = IsClipboardFormatAvailable(2): Loop While hPicAvail = 0
        With sh
            .Cells(i + (1 * 5), i + (1 * 5)).Select
            .Paste
        End With
        clipboardempty
    Next
End Sub
Private Sub clipboardempty()
    OpenClipboard 0: EmptyClipboard: CloseClipboard
    Do: DoEvents: hPicAvail = IsClipboardFormatAvailable(2): Loop Until hPicAvail = 0
End Sub

voila le resultat
Nom : demo.gif
Affichages : 1221
Taille : 1,38 Mo

a toi d'adapter la suite avec pdfcreator demande un coup de main a kiki29 il en est le king

**MelkInarian** · 12/12/2017, 19h28

Merci Patrick pour ces explications très bien exposées ...
ça m'a permis de modifier mon code rapidement.
Mais le problème subsiste avec ton code.
Bien que sur les 10 essais que je viens de faire ce soit toujours les même portions qui manquent sur les pages 2 et 3 alors qu'avant c'était plus aléatoire et sur une ou plusieurs des 4 pages qu'il manquait des pixels.
Je vais jusqu'à "OM" dans mes colonnes de données, donc ((26*14) +13 colonnes) soit 377 textboxes réparties sur les 4 pages.
serait-ce le nombre des données qui pourrait influer?
Voici le code tel que je l'ai modifié

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
97
98
99
100
101
102
103
104
 
 
Private Declare Sub keybd_event Lib "User32" ( _
ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)           ' voir plus bas ; impression d'écran
Private Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long                    ' voir plus bas ; je commence par vider le presse papier
Private Declare Function CloseClipboard Lib "User32" () As Long                                     ' voir plus bas ; je commence par vider le presse papier
Private Declare Function EmptyClipboard Lib "User32" () As Long                                     ' voir plus bas ; je commence par vider le presse papier
Private Declare Function IsClipboardFormatAvailable Lib "User32" (ByVal wFormat As Integer) As Long ' Gestion du presse papier
 
Private Sub CommandButton1_Click()
    Dim objFeuilProv As Worksheet                                   ' déclaration de l'objet objFeuilProv comme Feuille de calcul
    Dim PJ, Cel, Fin, P As String                                   ' Prénom - Nom du PJ ; Adresse de cellule "A1" ; Adresse de cellule de fin "N152" ; N° de page "P1"
    Dim i, Nb As Integer                                            ' i : Compteur de boucle ; Nb : Nombre de feuilles de calcul dans ce classeur
    Dim DureePause, Start, Finish, TotalTime
    Nb = ThisWorkbook.Worksheets.Count                              ' Je récupère le nombre de feuilles de calcul avant tout traitement
    ' je commence par vider le presse papier, pour éviter des collages intempestifs
    'L'objet ClipBoard n'existant pas en VBA, il faut utiliser les fonctions de l'API Windows :
    'Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    'Private Declare Function CloseClipboard Lib "user32" () As Long
    'Private Declare Function EmptyClipboard Lib "user32" () As Long
    ' le presse papier est vide
    Application.DisplayAlerts = False
    For Each objFeuilProv In ThisWorkbook.Worksheets                 ' suppression d'une éventuelle feuille préexistante nommée "provimp"
        If objFeuilProv.Name = "provimp" Then objFeuilProv.Delete
    Next
    Set objFeuilProv = Sheets.Add(After:=Sheets(Sheets.Count)): objFeuilProv.Name = "provimp"
    Application.DisplayAlerts = True
    For i = 0 To 3                                                  ' pour chacune des 4 pages (0 à 3) du controle 'MultiPage1'
        MultiPage1.Value = i                                        ' la 1ère page du multipage à le .value = 0 ; la seconde le .value = 1 ...
        clipboardempty
 
        Do: DoEvents: Loop Until MultiPage1.Value = i
        Me.Caption = "Page" & i + 1
        keybd_event vbKeySnapshot, 1, 0&, 0&  'on apuie                      ' évenement clavier (impression d'écran : récupérer une partie de ma capture d'écran keybd_event / vbKeySnapshot )
        keybd_event vbKeySnapshot, 1, &H2, 0&    'on relache
        Do: DoEvents: hPicAvail = IsClipboardFormatAvailable(2): Loop While hPicAvail = 0
 
        Select Case i
            Case 0: Cel = "A1"                                    ' si i=0 alors la cellule de destination de la 1ère image sera "A1"
                    Fin = "N40"                                    ' si i=0 alors la cellule de fin de la 1ère image sera "S40    "
                    P = "P1"                                        ' si i=0 alors c'est la page 1
            Case 1: Cel = "A43"                                     ' si i=1 alors la cellule de destination de la 1ère image sera "A43"
                    Fin = "N81"                                    ' si i=0 alors la cellule de fin de la 1ère image sera "S82"
                    P = "P2"                                        ' si i=1 alors c'est la page 2
            Case 2: Cel = "A85"                                     ' si i=2 alors la cellule de destination de la 1ère image sera "A83"
                    Fin = "N124"                                     ' si i=0 alors la cellule de fin de la 1ère image sera "S122"
                    P = "P3"                                        ' si i=2 alors c'est la page 3
            Case 3: Cel = "A127"                                      ' si i=3 alors la cellule de destination de la 1ère image sera "A123"
                    Fin = "N166"                                     ' si i=0 alors la cellule de fin de la 1ère image sera "S162"
                    P = "P4"                                        ' si i=3 alors c'est la page 4
             Case Else: MsgBox "Problème avec le n° de page..."      ' Mais que ce passe-t'il ?
        End Select
 
 
        objFeuilProv.Paste Destination:=objFeuilProv.Range(Cel & ":" & Fin)  ' La Méthode Worksheet.Paste colle le contenu du Presse-papiers dans la feuille - ici une image dans la feuille provisoire : l'objet objFeuilProv
        objFeuilProv.Shapes(i + 1).Name = P                            ' L'objet est nommé  "f(case) plus haut"
 
 
        'With objFeuilProv
        '    .Cells(i + (1 * 5), i + (1 * 5)).Select
        '    .Paste
        'End With
        clipboardempty
    Next
 
    PJ = TB_Prenom.Value & " " & CB_NomPJ.Value                     ' affecte le prénom et nom du PJ à la variable PJ
 
    ActivePrinter = "PDFCreator sur Ne00:"                          ' Définit l'imprimante active comme étant : PDFCreator
 
    With objFeuilProv.PageSetup
            .LeftMargin = Application.CentimetersToPoints(0.45)     ' Renvoie ou définit la largeur de la marge de gauche, en points - (ici transformée en cm par 'CentimetersToPoints')
            .RightMargin = Application.CentimetersToPoints(0.5)     ' Renvoie ou définit la largeur de la marge de droite, exprimée en points -  (ici transformée en cm par 'CentimetersToPoints')
            .TopMargin = Application.CentimetersToPoints(1.2)       ' Cette propriété renvoie ou définit la taille de la marge supérieure, exprimée en points -  (ici transformée en cm par 'CentimetersToPoints')
            .BottomMargin = Application.CentimetersToPoints(0.5)    ' Cette propriété renvoie ou définit la taille de la marge du bas, en points (ici transformée en cm par 'CentimetersToPoints')
            .HeaderMargin = Application.CentimetersToPoints(0.25)   ' Cette propriété renvoie ou définit la distance entre le haut de la page à l'en-tête, exprimée en points - (ici transformée en cm par 'CentimetersToPoints')
            .FooterMargin = Application.CentimetersToPoints(0.25)   ' Cette propriété renvoie ou définit la distance à partir du bas de la page au pied de page, exprimée en points  -  (ici transformée en cm par 'CentimetersToPoints')
 
            .LeftHeader = PJ                                        ' Renvoie ou définit l’alignement du texte dans l’en-tête gauche d’un classeur ou d’une section - Nom et prénom du PJ dans l'entête à gauche
            .CenterHeader = " "                                     ' Centre aligne les informations d'en-tête de l'objet PageSetup - un vide dans l'entête au centre
            .RightHeader = " "                                      ' Cette propriété renvoie ou définit la partie droite de l'en-tête - un vide dans l'entête à droite
            .LeftFooter = " "                                       ' Renvoie ou définit l’alignement du texte dans le pied de page gauche d’un classeur ou d’une section
            .CenterFooter = "&D" & ""                               ' Centre le contenu du pied de page dans l'objet PageSetup - La date dans le pied de page au centre
            .RightFooter = "page " & "&P" & " sur " & "&N"          ' Cette propriété renvoie ou définit la distance (en points) entre le bord droit de la page et la bordure droite du pied de page - N° de page / Nb pages dans le pied de page à droite
 
            .PrintErrors = 0                                        ' Définit ou renvoie une constante XlPrintErrors indiquant le type d'erreur d'impression affiché. Cette fonctionnalité permet aux utilisateurs de supprimer l'affichage des valeurs d'erreur lors de l'impression d'une feuille de calcul. | (ici 0, xlPrintErrorsDisplayed, Toutes les erreurs d'impression s'affichent.)
            .Orientation = xlLandscape                              ' Renvoie ou définit une valeur XlPageOrientation qui représente le mode d’impression en Portrait ou Paysage. - xlLandscape = Mode Paysage
            .Zoom = 88                                              ' Cette propriété renvoie ou définit une valeur de type Variant qui représente un pourcentage (compris entre 10 et 400 pour cent utilisé) par lequel Microsoft Excel pour une mettre à l'échelle de la feuille de calcul pour l'impression.
            .PaperSize = xlPaperA4                                  ' Renvoie ou définit la taille du papier. Type de données XlPaperSize - xlPaperA4 = A4 (21 x 29,7 cm)
            .CenterVertically = True                                ' True si la feuille est centrée verticalement sur la page lors de son impression.
    End With
 
    objFeuilProv.PrintOut                                           ' lance l'impression de la feuille "ProvImp"
 
    Application.DisplayAlerts = False                               ' Empêche l'affichage d'une boite d'alerte
    'objFeuilProv.Delete                                             ' Supprime l'objet objFeuilProv
    Application.DisplayAlerts = True                                ' Rétablit l'affichage des boites d'alerte
    'Set objFeuilProv = Nothing                                      ' on vide la variable de objFeuilProv
    MultiPage1.Value = 0                                            ' Définit la 1ère page du MultiPages comme page affichée.
    Me.Caption = ""
End Sub
Private Sub clipboardempty()
    OpenClipboard 0: EmptyClipboard: CloseClipboard
    Do: DoEvents: hPicAvail = IsClipboardFormatAvailable(2): Loop Until hPicAvail = 0
End Sub

jai supprimé la partie

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
        'With objFeuilProv
        '    .Cells(i + (1 * 5), i + (1 * 5)).Select
        '    .Paste
        'End With

car pour l'impression il ne faut pas de chevauchement sinon j'ai le chevauchement qui est imprimé!
donc mon select case me sert au décalage.

Merci

**patricktoulon** · 12/12/2017, 19h36

re
dis moi il n'y a pas quelque chose qui manque dans ton "With objFeuilProv.PageSetup"
peu etre la definition du range non?????etant donné que tu adapte la taille de l image a deb et fin

j'dis'ca'moi j'dis rien hein

**MelkInarian** · 12/12/2017, 20h09

Merci Patrick,
j'ai l'impression d'abuser et de te 'donner des boutons'!
Certainement que j'ai oublié quelque chose, mais je ne vois pas quoi.
dans les propriétés de PageSetup je ne vois rien qui pourrait passer pour un range pour imprimer une usf.
https://msdn.microsoft.com/fr-fr/lib.../dn254188.aspx
De plus, sur les images stockées sur ma sheet provisoire j'ai bien les "blancs" donc avant d'appeler PageSetup .
Mon manque pourrait être dans la boucle "For i = 0 To 3".
Qu'en dis-tu?
merci

**patricktoulon** · 12/12/2017, 20h17

bien que je comprenne pas pourquoi tu cherche a faire 4 plage dans ton case dans le ActiveSheet.PageSetup tu ne parametre pas le print area
en gros ton case ne te sert a rien pour le moment
exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
with  ActiveSheet.PageSetup
.PrintArea = "B1:F14"' a toi d'adapter tes deux cellules des cases a chaque page
'..reste du code

voila ce que tu oublie

ca y est sur ton lien il ne faut pas lire en diagonale

Nom : Capture.JPG
Affichages : 1086
Taille : 99,6 Ko

**MelkInarian** · 12/12/2017, 20h47

J'avais lu mais comme ils parlent de référence type A1 j'avais pensé, à tord, que c'était pour une sheet.
Mais quoi qu'il en soit avec ".PrintArea = "A1:N166" ' pour prendre mes 4 pages"
C’est pareil. Mon pdf semble identique avec ou sans PrintArea !
Comme je le disais précédemment, les blancs sont déjà sur les images stockées sur la sheet provisoire donc à l’impression ils y sont toujours.
Serait-il possible que ce soit au moment de la "photo", que tout n'est pas visible pour la copie d'écran ?

**patricktoulon** · 12/12/2017, 23h03

re
a ben oui je vois que cacela dit je me demande comment ca peut se produire
il me faudrait un exemple de fichier avec tes userforms en condition reelle

sinon tu a directement printform tu peux toujours essayer

**MelkInarian** · 13/12/2017, 10h34

Bonjour à tous et un merci particulier à PatrickToulon,
Je viens de refaire entièrement mon usf, avec un multipage à 4 pages pour le cas ou quelque chose se serait caché dans un cadre hors de vue (à un top ou un left trop grands) et causerait des soucis. Ce n'était pas ça car le problème subsistait.
Mais lors de l'un des multiples test j'ai remarqué que le rafraichissement entre les "photos" n'était pas bon, j'ai pensé que trop de données à rafraichir pouvaient "encombrer la ligne".
j'ai donc rajouté mon timer :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
        DureePause = 1.5                                              ' définit une durée de pause en secondes, ici 1/2s
        Start = Timer                                               ' définit le moment du départ.
        Do While Timer < Start + DureePause                         ' tant que le timer n'est pas arrivé à moment du départ plus DureePause
                DoEvents                                            ' Arrête momentanément l'exécution afin que le système d'exploitation puisse traiter d'autres événements.
        Loop                                                        ' boucle
        ' rajouté juste avant
        Do: DoEvents: Loop Until MultiPage1.Value = i               ' parfois le value du multipage n'est pas a jours ; un tout petit do loop sur son etat fera l'affaire

à ton code, et là "nickel!" ça marche à tous les coups sur 8 essais.
C'est un peu longuet, mais bon, le résultat est là.

Merci Partick pour le code et toutes les explications.

**patricktoulon** · 13/12/2017, 12h37

re
bonjour
1.5 seconde entre chaque capture plus les do/loop d'attente c'est etonnant et un peu long quand meme a mon gout

chez moi sans ca fonctionne tres bien ton PC est peu etre un peu vieux non?

**MelkInarian** · 13/12/2017, 14h55

Salut Patrick,
Mon PC n'est pas trop vieux, il n'a pas 2 ans et sans être une bête de jeux je le trouvais assez rapide.
Maintenant, avec toutes les tâches de fond qui peuvent tourner toutes seules, anti-virus et autres va savoir!
Il est vrai que je n'ai pas essayé avec une tempo inférieur à 1.5, c'était la dernière que j'avais testée avant ton code.
Je vais faire des essai avec tempo plus courte pour voir, mais depuis ce matin j'ai fait des dizaines de tests pour la suite du prog et je n'ai plus eu aucun problème de portions d'images absentes.
encore merci.

à une époque il me semblait qu'on pouvait mettre un pouce levé, en remerciements, lorsqu'on était contant du GUIDE, j'ai cherché et n'ai pas trouvé.
Peut-être me trompe-je. toujours ma mémoire

**MelkInarian** · 13/12/2017, 14h58

ça y est, j'ai trouvé le pouce levé,
je croyais qu'il était pour toute la discussion mais c'est post / post.
en fait j'essayais sur mon message et il faut le faire sur les tiens,
je viens de le faire.

**patricktoulon** · 13/12/2017, 16h54

re
merci ravi pour toi

si j'avais un exemple de ton fichier je pourrais regarder pourquoi tu a besoins de ce timer chez toi alors que moi non

apres je t'avais aussi dis de regarder du coté de printform comme ca il n'y a pas la caption de l'userform seulement l'interieur
il te faut mettre certainement pdfcreator en imprimante par defaut ca tu le fait deja il me semble
apres il suffit de ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Private Sub CommandButton1_Click()
For i = 0 To 3
MultiPage1.Value = i
Do: DoEvents: Loop Until MultiPage1.Value = i
Me.PrintForm
Next
End Sub

prends le temps de considérer cet option

a mediter

**MelkInarian** · 13/12/2017, 18h06

Je viens de tester printform mais ça ne me convient pas car soit je l'utilise mal, ce qui est fort possible,
soit il imprime page à page et à chaque fois dans un pdf différent. Hors je souhaite n'obtenir qu'un seul fichier.
je n'arrive pas à paramétrer l'imprimante pour qu'elle passe en paysage même si je déplace

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
    With objFeuilProv.PageSetup
            .PrintArea = "A1:N168"                                  ' a toi d'adapter tes deux cellules des cases a chaque page
            .LeftMargin = Application.CentimetersToPoints(0.45)     ' Renvoie ou définit la largeur de la marge de gauche, en points - (ici transformée en cm par 'CentimetersToPoints')
            .RightMargin = Application.CentimetersToPoints(0.5)     ' Renvoie ou définit la largeur de la marge de droite, exprimée en points -  (ici transformée en cm par 'CentimetersToPoints')
            .TopMargin = Application.CentimetersToPoints(1.2)       ' Cette propriété renvoie ou définit la taille de la marge supérieure, exprimée en points -  (ici transformée en cm par 'CentimetersToPoints')
            .BottomMargin = Application.CentimetersToPoints(0.5)    ' Cette propriété renvoie ou définit la taille de la marge du bas, en points (ici transformée en cm par 'CentimetersToPoints')
            .HeaderMargin = Application.CentimetersToPoints(0.25)   ' Cette propriété renvoie ou définit la distance entre le haut de la page à l'en-tête, exprimée en points - (ici transformée en cm par 'CentimetersToPoints')
            .FooterMargin = Application.CentimetersToPoints(0.25)   ' Cette propriété renvoie ou définit la distance à partir du bas de la page au pied de page, exprimée en points  -  (ici transformée en cm par 'CentimetersToPoints')
 
            .LeftHeader = PJ                                        ' Renvoie ou définit l’alignement du texte dans l’en-tête gauche d’un classeur ou d’une section - Nom et prénom du PJ dans l'entête à gauche
            .CenterHeader = " "                                     ' Centre aligne les informations d'en-tête de l'objet PageSetup - un vide dans l'entête au centre
            .RightHeader = " "                                      ' Cette propriété renvoie ou définit la partie droite de l'en-tête - un vide dans l'entête à droite
            .LeftFooter = " "                                       ' Renvoie ou définit l’alignement du texte dans le pied de page gauche d’un classeur ou d’une section
            .CenterFooter = "&D" & ""                               ' Centre le contenu du pied de page dans l'objet PageSetup - La date dans le pied de page au centre
            .RightFooter = "page " & "&P" & " sur " & "&N"          ' Cette propriété renvoie ou définit la distance (en points) entre le bord droit de la page et la bordure droite du pied de page - N° de page / Nb pages dans le pied de page à droite
 
            .PrintErrors = 0                                        ' Définit ou renvoie une constante XlPrintErrors indiquant le type d'erreur d'impression affiché. Cette fonctionnalité permet aux utilisateurs de supprimer l'affichage des valeurs d'erreur lors de l'impression d'une feuille de calcul. | (ici 0, xlPrintErrorsDisplayed, Toutes les erreurs d'impression s'affichent.)
            .Orientation = xlLandscape                              ' Renvoie ou définit une valeur XlPageOrientation qui représente le mode d’impression en Portrait ou Paysage. - xlLandscape = Mode Paysage
            .Zoom = 88                                              ' Cette propriété renvoie ou définit une valeur de type Variant qui représente un pourcentage (compris entre 10 et 400 pour cent utilisé) par lequel Microsoft Excel pour une mettre à l'échelle de la feuille de calcul pour l'impression.
            .PaperSize = xlPaperA4                                  ' Renvoie ou définit la taille du papier. Type de données XlPaperSize - xlPaperA4 = A4 (21 x 29,7 cm)
            .CenterVertically = True                                ' True si la feuille est centrée verticalement sur la page lors de son impression.
    End With

avant l'appel à printform.
En cherchant j'y arriverai mais si çà ne fait qu'une page par pdf c'est rédhibitoire.
Peux-tu m'éclairer sur ce point avant que je ne me lance dans des recherches ardues.
Merci

**MelkInarian** · 13/12/2017, 18h23

Je viens de faire quelques test de timer et en mettant le timer et ta boucle (sans le printform) çà marche avec 5/100s mais pas avec 1/100s.
donc maintenant pour le temps d'attente c'est OK

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
        DureePause = 0.05                                              ' définit une durée de pause en secondes, ici 5/100s
        Start = Timer                                               ' définit le moment du départ.
        Do While Timer < Start + DureePause                         ' tant que le timer n'est pas arrivé à moment du départ plus DureePause
                DoEvents                                            ' Arrête momentanément l'exécution afin que le système d'exploitation puisse traiter d'autres événements.
        Loop                                                        ' boucle
 
        Do: DoEvents: Loop Until MultiPage1.Value = i               ' parfois le value du multipage n'est pas a jours ; un tout petit do loop sur son etat fera l'affaire
        'Me.PrintForm

je peux quand même t'envoyer le fichier si tu le souhaite.
Je te remercie Patrick

**patricktoulon** · 13/12/2017, 18h52

En cherchant j'y arriverai mais si çà ne fait qu'une page par pdf c'est rédhibitoire.

re justement il me semble (presque sur)que l'on peu metriser le "enqueue"(ajouter dans pdf une page ) avec pdfcreator il faudrait que tu regarde les tuto de kiki29 et rapproche toi de lui le cas echeant
j'avoue que moi je ne m'en sert pas j'ai bullzip comme imprimante PDF et je peux le faire
je vais faire une recherche de mon coté aussi

j'ai fait une recherche
https://www.developpez.net/forums/d1...-pdf-existant/
https://excel.developpez.com/telecha...FCreator-Excel

Imprimer plusieurs pages d'un multipage [XL-2007]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager