Impression Userform PtrSafe

**Alaindhu** · 15/05/2017, 14h52

Bonjour à tous,

J'essai d'imprimer correctement un userform comportant 7 onglets. mais j'ai un pb avec la fonction DECLARE:

Code :

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

1
2
Private Declare Sub keybd_event Lib "user32" ( _
ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

En effet, Excel me demande de mettre à jour mon code pour pouvoir être utilisé en 64 bits. et me demande de les marquer avec l'attribut PtrSafe.
N'ayant pas trouvé dans les forums, je me permets de poser la question ici. Avez-vous une idée?
Ci-dessous le code dans son intégralité:
merci de votre aide!!

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
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
UFSaisie.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
UFSaisie.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
UFSaisie.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

**parmi** · 15/05/2017, 15h42

Bonjour,

Essaie comme ceci

Code :

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

Declare PtrSafe Sub keybd_event Lib "user32" Alias "keybd_event" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)

Tu peux installer un fichier d'aide pour la déclaration des API que tu peux trouver ICI, si tu en utilises plusieurs...

**Alaindhu** · 15/05/2017, 16h07

Merci pour ta réponse! alors maintenant j'ai un nouveau message d'erreur (j'ai placé la fonction Declare dans Workbook) mais carrément dès le début de mon code au niveau de

Code :

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

Private Sub CmdImpression_Click()

(il me dit sub non définie, je ne comprends pas pourquoi...)

En gros, je cherche à imprimer mon userform + les onglets qui suivent dans un document mais cela a l'air extrêmement complexe:

Nom : Capture.PNG
Affichages : 1278
Taille : 57,5 Ko

Nom : Capture.PNG
Affichages : 1278
Taille : 57,5 Ko

Merci encore de votre aide!

**parmi** · 15/05/2017, 16h20

Place la déclaration dans un module.
Autrement, il te faut la déclarer Private

Quel est ton système d'exploitation ?
Est-ce un Windows 64 bits et Office 64 bits ? sinon lequel est 32 bits ?

**Alaindhu** · 15/05/2017, 16h37

Mon système est 64 bits et mon Excel est également 64 bits:
Nom : Capture.PNG
Affichages : 995
Taille : 5,3 Ko

**parmi** · 15/05/2017, 17h38

Tu dis qu'il te fait une erreur sur la ligne

Code :

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

Private Sub CmdImpression_Click()

Et dans ton premier code, la Sub se nommait

Code :

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

Private Sub btImprimer_Click()

Est-ce que tu as modifié ton code entretemps ?
Est-ce bien la ligne de la Sub qui est surlignée en jaune ?

**Alaindhu** · 15/05/2017, 18h58

Envoyé par parmi

Place la déclaration dans un module.
Autrement, il te faut la déclarer Private

Quel est ton système d'exploitation ?
Est-ce un Windows 64 bits et Office 64 bits ? sinon lequel est 32 bits ?

MERCI!!!
ça a fonctionné, cela a imprimé! j'arrive au bout

Bon, j'ai fait quelques tests en modifiant des valeurs.
En faisant du pas à pas je me rends compte que le problème vient probablement du collé. en tout cas, il change bien les onglets à chaque fois...
je n'arrive pas à régler les Top, left etc... et le mode paysage...

voici à quoi mon code modifié ressemble:

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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
Private Sub btImprimer_Click()
Dim objFeuilPass As Worksheet
 
On Error Resume Next
 
 
MultiPage1.Value = 0
UFsaisie.Repaint
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
Sheets.Add.Name = "PassImp"
Set objFeuilPass = Sheets("PassImp")
objFeuilPass.Paste
With objFeuilPass.Shapes(1)
    .Top = 1
    .Left = 5
    .Height = 325
    .Width = 125
End With
objFeuilPass.PrintOut
 
MultiPage1.Value = 1
UFsaisie.Repaint
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
Sheets.Add.Name = "PassImp1"
Set objFeuilPass = Sheets("PassImp1")
objFeuilPass.Paste
With objFeuilPass.Shapes(2)
    .Top = 3
    .Left = 200
    .Height = 180
    .Width = 300
End With
'objFeuilPass.PrintOut
 
MultiPage1.Value = 2
UFsaisie.Repaint
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
Sheets.Add.Name = "PassImp2"
Set objFeuilPass = Sheets("PassImp2")
objFeuilPass.Paste
With objFeuilPass.Shapes(2)
    .Top = 3
    .Left = 200
    .Height = 180
    .Width = 300
End With
'objFeuilPass.PrintOut
 
MultiPage1.Value = 3
UFsaisie.Repaint
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
Sheets.Add.Name = "PassImp3"
Set objFeuilPass = Sheets("PassImp3")
objFeuilPass.Paste
With objFeuilPass.Shapes(2)
    .Top = 3
    .Left = 200
    .Height = 180
    .Width = 300
End With
'objFeuilPass.PrintOut
 
MultiPage1.Value = 4
UFsaisie.Repaint
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
Sheets.Add.Name = "PassImp4"
Set objFeuilPass = Sheets("PassImp4")
objFeuilPass.Paste
With objFeuilPass.Shapes(2)
    .Top = 3
    .Left = 200
    .Height = 180
    .Width = 300
End With
'objFeuilPass.PrintOut
 
MultiPage1.Value = 5
UFsaisie.Repaint
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
Sheets.Add.Name = "PassImp5"
Set objFeuilPass = Sheets("PassImp5")
objFeuilPass.Paste
With objFeuilPass.Shapes(2)
    .Top = 3
    .Left = 200
    .Height = 180
    .Width = 300
End With
'objFeuilPass.PrintOut
 
MultiPage1.Value = 6
UFsaisie.Repaint
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
Sheets.Add.Name = "PassImp6"
Set objFeuilPass = Sheets("PassImp6")
objFeuilPass.Paste
With objFeuilPass.Shapes(2)
    .Top = 3
    .Left = 200
    .Height = 180
    .Width = 300
End With
'objFeuilPass.PrintOut
 
MultiPage1.Value = 7
UFsaisie.Repaint
keybd_event vbKeySnapshot, 1, 0&, 0&
DoEvents
Sheets.Add.Name = "PassImp6"
Set objFeuilPass = Sheets("PassImp6")
objFeuilPass.Paste
With objFeuilPass.Shapes(2)
    .Top = 3
    .Left = 200
    .Height = 180
    .Width = 300
End With
'objFeuilPass.PrintOut
 
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 = "EEA"
        .CenterHeader = " "
        .RightHeader = " "
        .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

**parmi** · 15/05/2017, 19h58

Je n'ai jamais utilisé, mais je pense que tu doives simuler le "relâchement" du bouton avec

Code :

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

keybd_event VK_SNAPSHOT, 1, KEYEVENTF_KEYUP, 0

Donc, en principe, tu déclares les constantes en début de module, sous le Declare (Private si dans le code du Userform, Public si dans un module)

Code :

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

1
2
3
Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_SNAPSHOT = &H2C
Private Const VK_MENU = &H12

Tu sélectionnes l'onglet et mets

Code :

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

1
2
3
4
    keybd_event VK_SNAPSHOT, 1, 0, 0  'La touche Impr Écran est pesée
    keybd_event VK_SNAPSHOT, 1, KEYEVENTF_KEYUP, 0   'la touche est relâchée
 
    Application.Wait Now + TimeValue("00:00:01")   ' Tu attends 1 seconde

Tu ajoutes ta feuille, tu colles, et tu imprimes, puis tu refais le même processus

Impression Userform PtrSafe

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager