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 |
Imprimer plusieurs pages d'un multipage
Répondre avec citation
Partager