Impression Userform PtrSafe

Version imprimable

Bonjour à tous,

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

Code:

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:

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

15/05/2017, 15h42
parmi

Bonjour,

Essaie comme ceci

Code:

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...
15/05/2017, 16h07
Alaindhu

1 pièce(s) jointe(s)

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:

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:

Pièce jointe 275684

Merci encore de votre aide!
15/05/2017, 16h20
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 ?
15/05/2017, 16h37
Alaindhu

1 pièce(s) jointe(s)

Mon système est 64 bits et mon Excel est également 64 bits:
Pièce jointe 275699
15/05/2017, 17h38
parmi

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

Code:

Private Sub CmdImpression_Click()

Et dans ton premier code, la Sub se nommait

Code:

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 ?
15/05/2017, 17h46
kiki29

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.

Citation:

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.

Citation:

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:

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

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

Code:

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:

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:

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

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:

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:

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:

_

mais sans succès

Code:

keybd_event VK_SNAPSHOT, 1, KEYEVENTF_KEYUP, 0

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:

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

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:

keybd_event VK_SNAPSHOT, 1, KEYEVENTF_KEYUP, 0

Sinon, voici mon code revu avec une boucle FOR:

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

Bonjour

Citation:

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:

1 2 Me.PrintForm

;)

allez exemple pour imprimer toute les pages d'un multipage
Code:

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

16/05/2017, 14h08
parmi

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 ?
16/05/2017, 14h42
patricktoulon

re

oui visiblement ca fonction sans soucis

sinon j'en ai une autre de methode sans apis avec la touche snapshot vous la voulez????
16/05/2017, 16h29
Alaindhu

1 pièce(s) jointe(s)
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:

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:
Pièce jointe 276104

dans le meme principe que toi mais sans api

Code:

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

17/05/2017, 15h17
Alaindhu

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