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 : 1144
Taille : 57,5 Ko

Nom : Capture.PNG
Affichages : 1144
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 : 891
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 ?

**kiki29** · 15/05/2017, 17h46

Salut, à toi de voir et appliquer : Développer avec Office 64 bits

Même Microsoft déconseille l'installation d'une version 64 bits d'Office.

Office 32 bits est recommandé pour la plupart des utilisateurs
Nous recommandons la version 32 bits d’Office pour la plupart des utilisateurs, car elle offre une plus grande compatibilité avec la plupart des autres applications, en particulier les compléments tiers. C’est la raison pour laquelle la version 32 bits d’Office est installée par défaut, même sur les systèmes d’exploitation Windows 64 bits. Sur ces systèmes, le client Office 32 bits est pris en charge en tant qu’installation Windows-32-on-Windows-64 (WOW64). WOW64 est l’émulateur x86 qui permet l’exécution de façon transparente des applications Windows 32 bits sur les systèmes Windows 64 bits. Cela permet aux utilisateurs de continuer à utiliser les contrôles ActiveX et les compléments COM Microsoft avec la version 32 bits d’Office.

**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

**Alaindhu** · 16/05/2017, 11h28

merci pour ton aide, je suis désolé mais un doute, du coup peux-tu me confirmer que je met les constantes dans mon module public de cette manière

Code :

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

1
2
3
4
Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
Const KEYEVENTF_KEYUP = &H2
Const VK_SNAPSHOT = &H2C
Const VK_MENU = &H12

Puis l'"action" dans mon code userform:

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
Private Sub btImprimer_Click()
Dim objFeuilPass As Worksheet
 
On Error Resume Next
    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
 
 
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

Mais ou dois-je mettre cela stp? j'ai essayé de l'inclure au Declare avec

Code :

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

mais sans succès

Code :

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

keybd_event VK_SNAPSHOT, 1, KEYEVENTF_KEYUP, 0

**parmi** · 16/05/2017, 11h49

Pour la déclaration, oui, dans un module en Public comme tu le fais

Pour le code, j'irais avec quelque chose comme ceci.
L'attente d'une seconde est à vérifier et à mettre en commentaire si ça passe sans ça.

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
Private Sub btImprimer_Click()
    Dim objFeuilPass As Worksheet
 
    On Error Resume Next
 
    MultiPage1.Value = 0
    UFsaisie.Repaint
        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 au cas où
    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
'...............
 
End Sub

Et ça pourrait se mettre dans une boucle...

**Alaindhu** · 16/05/2017, 13h03

Super merci! je sens que je touche au but!
Il y 'a juste ce bout de code à déclarer que je ne vois pas du tout ou mettre:

Code :

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

keybd_event VK_SNAPSHOT, 1, KEYEVENTF_KEYUP, 0

Sinon, voici mon code revu avec une boucle FOR:

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
Private Sub btImprimer_Click()
Dim objFeuilPass As Worksheet
Dim i As Long
Dim haut As Long
 
On Error Resume Next
 
i = 0
haut = 3
 
For i = 0 To i = 7
    MultiPage1.Value = i
    UFsaisie.Repaint
        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
    DoEvents
    Sheets.Add.Name = "PassImp" & i
    Set objFeuilPass = Sheets("PassImp" & i)
    objFeuilPass.Paste
    With objFeuilPass.Shapes(1)
        .Top = haut
        .Left = 40
        .Height = 390
        .Width = 448
    End With
    i = i + 1
    haut = haut + 247
Next
 
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

**patricktoulon** · 16/05/2017, 13h12

Bonjour

Bonjour à tous,

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

allez je jette une couillete dans le potage c'est tout moi ca

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

1
2
Me.PrintForm

allez exemple pour imprimer toute les pages d'un multipage

Code :

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

1
2
3
4
5
6
Private Sub CommandButton3_Click()
For i = 0 To Me.MultiPage1.Pages.Count - 1
Me.MultiPage1.Value = i
Me.PrintForm
Next
End Sub

voila

**parmi** · 16/05/2017, 14h08

Salut Patrick,

Je me rappelle de PrintForm en VB6, mais il arrivait qu'il imprime certains contrôles en noir (FlexGrid entre autres).
Est-ce que ça fonctionne mieux sous VBA ?

**patricktoulon** · 16/05/2017, 14h42

oui visiblement ca fonction sans soucis

sinon j'en ai une autre de methode sans apis avec la touche snapshot vous la voulez????

**Alaindhu** · 16/05/2017, 16h29

A oui Ok en cinq lignes... en tout cas cela fonctionne niquel. la seule chose c'est qu'il faudrait que je puisse l'imprimer en paysage.

J'ai tenté cela:

Code :

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

1
2
3
4
5
6
7
Private Sub CommandButton1_Click()
Dim i As Long
For i = 0 To UFsaisie.MultiPage1.Pages.Count - 1
UFsaisie.MultiPage1.Value = i
UFsaisie.PrintForm = xlLandscape
Next
End Sub

Mais évidemment cela ne va pas. Savez vous comment faire?
en tout cas merci à vous deux pour tout le temps passé à m'aider.

en gros j'ai cela:
Nom : Capture.PNG
Affichages : 941
Taille : 137,1 Ko

Nom : Capture.PNG
Affichages : 941
Taille : 137,1 Ko

**patricktoulon** · 17/05/2017, 00h18

dans le meme principe que toi mais sans api

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
Private Sub CommandButton3_Click()
'Application.CutCopyMode = False    'on bloque la copie en clipboard (effet de vidage)
'With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"): .SetText "": .PutInClipboard: End With 'on bloque la copie en clipboard (effet de vidage)
    ReDim tablo(Me.MultiPage1.Pages.Count - 1)    'on dimentionne la variable tablo au nombre de page dans le multipage
    For i = 0 To Me.MultiPage1.Pages.Count - 1    'on boucle sur tout les page du multipage
        Set sh = Sheets.Add(After:=Sheets(Sheets.Count))    'on ajoute un sheet
        sh.Name = "page" & i    'on nomme le sheets
        Me.MultiPage1.Value = i    'on change de page
        For a = 1 To 30: Application.SendKeys "(%{1068})": Next    'cette ligne remplace la manipulation de la touche snapshot avec les api
        sh.Cells(1, 1).Select    'on selectionne la cellule ou doit etre poser la capture
        DoEvents
        sh.Paste    ' on colle ce qui a été pris en cliché par la touche snapshot
        ActiveSheet.PageSetup.Orientation = xlLandscape
        tablo(i) = "page" & i    ' on ajoute le nom de la nouvelle feuille dans le tablo
    Next
    Unload Me    ' on ferme le userform
    Sheets(tablo).PrintPreview    ' apercu des feuilles a imprimer
    'Sheets(tablo).PrintOut  ' apercu des feuilles a imprimer
    Application.DisplayAlerts = False    'on bloque le message d'alert qui va me demander si je veux vraiment supprimer les sheets
    Sheets(tablo).Delete    ' suppression des sheets calques des userforms
End Sub

**Alaindhu** · 17/05/2017, 15h17

C'est super, un grand merci à vous deux, cela fonctionne parfaitement maintenant!
Bonne journée!

Impression Userform PtrSafe

Macros et VBA Excel

Discussions similaires

Partager

Partager