Bonjour à tous,

Tout d'abord, je suis vraiment désolé de venir vous embêter avec mon problème VBA, mais malheureusement je n'arrive pas à y remédier tout seul malgré de nombreuses tentatives.

J'ai bien lu et compris les rêgles de votre forum.

Je suis un néophyte complet, la dernière fois que j'ai touché à du code c’était en 6ème, lorsque je programmais ma calculette avec des bouquins pour avoir des jeux pendant les intercours.

J'ai commencé VBA vendredi dernier, avec des tutos et beaucoup d'informations glanés ici et là, sur le net, afin de créer un formulaire qui me permettrai de générer des étiquettes uniques automatiquement.

Votre forum et vos tutos ont déjà été d'une aide précieuse, mais je n'arrive pas à trouver une situation suffisamment similaire pour m'en inspirer.

Pour ce faire, j'ai crée un Userform (TextBox et ComboBox) qui, une fois rempli, contrôle les champs (Mise en forme, non vide) et si ok va générer un fichier texte contenant des lignes de commandes (Pour générer mes images de QR code) et un classeur EXCEL de données pour le publipostage WORD (qui me permet de créer mes planches d'étiquettes uniques)

Tout fonctionne, mes étiquettes sont conformes.

Mais parfois, il va planter sur les deux ActiveSheet.Paste (L82) et L104 avec une erreur d’exécution '1004' impossible d'exécuter cette commande sur des sélections multiples. lors du débogage, "F5" me permet de poursuivre l'opération sans modification et tout fonctionne de nouveau, mes étiquettes sont conformes.

Je sais que faire du copier coller de sélections sous EXCEL en VBA c’était très sale, mais je n'ai pas trouver un moyen de contournement.

J'ai essayé d'isoler le problème, mais je n'arrive pas à reproduire ce bug à la demande.

Voici mes tentatives de résolution:

- J'ai essayé de vider mon presse papier à plusieurs moments lors du Process
- J'ai essayé de passer par la fonction .Copy
- J'ai tenté de récrire cette portion de code pour utiliser au minimum les Activexxxxx.


Pour en revenir au classeur en lui même, c'est un fichier .xlsm composé de 5 feuilles (4 cachées, 1 feuille vierge visible) :
- La feuille "DATAQR" va stocker les lignes de commandes, elle est ensuite copiée dans un nouveau classeur puis cette copie est enregistrée en fichier texte "TEMP-EXPORTDATAQR.txt" qui deviendra le batch de création des QRCODE.
- La feuille "DESCRIPTION" est une table de correspondance entre mes références produit et mes libellés.
- La feuille "LABEL" va stocker les données du publipostage WORD, elle est copiée dans un nouveau classeur puis cette copie est enregistrée sous "TEMP-EXPORTLABEL.xls".
- La feuille "LISTING" stocke mes listes de COMBOBOX.

Ci dessous, vous trouverez le code de mon bouton OK, qui va déclencher les opérations de peuplement, de copie et sauvegarde puis le déclenchement du publipostage WORD.

Je sais que ce code va heurter la sensibilité des plus aguerris d'entre vous, et j'en suis humblement et sincèrement désolé, je suis totalement conscient que c'est du bricolage, et qu'on est loin des règles de l'art.

Je vous remercie de toute l'aide que vous pourrez m'apporter, que ce soit des conseils, des remarques d'optimisation, ou simplement des pistes.

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
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
Private Sub BoutonOK_Click()
'Je verifie que mes champs sont remplis
    If Me.BoxReference = "" Then
        MsgBox "Please Enter a Reference.", vbOKOnly + vbCritical
        Me.BoxReference.SetFocus
        Exit Sub
    End If
    If Me.BoxSize = "" Then
        MsgBox "Please Enter a Size. (If this product is without a size then enter 00).", vbOKOnly + vbCritical
        Me.BoxSize.SetFocus
        Exit Sub
    End If
    If Me.BoxGravure = "" Then
        MsgBox "Please Enter a N°", vbOKOnly + vbCritical
        Me.BoxGravure.SetFocus
        Exit Sub
    End If
    If Me.BoxGravure.TextLength <> 6 Then
        MsgBox "Invalid N° Format, must be 2 letters and 4 digits (ex: AB0123).", vbOKOnly + vbCritical
        Me.BoxGravure.SetFocus
        Exit Sub
    End If
    If Not Me.BoxGravure.Value Like "[A-z][A-z]####" Then
        MsgBox "Invalid N° Format, must be 2 letters and 4 digits (ex: AB0123).", vbOKOnly + vbCritical
        Me.BoxGravure.SetFocus
        Exit Sub
    End If
    If Me.BoxQTY = "" Then
        MsgBox "Please Enter a QTY", vbOKOnly + vbCritical
        Me.BoxQTY.SetFocus
        Exit Sub
    End If
    If Me.BoxPOIDSM1 = "" Then
    MsgBox "Please Enter a Metal weight, in grams", vbOKOnly + vbCritical
    Me.BoxPOIDSM1.SetFocus
        Exit Sub
    End If
'Je lance la génération des Réferences QR CODE avec la Quantité spécifiée
    Q = BoxQTY.Value
    GravureNo = Left(BoxGravure.Value, 2)
    NumGrav = 100000 & Right(BoxGravure.Value, 4)
 
    If BoxPIERRE1.Value <> "" Then BoxPIERRE1.Value = UCase(BoxPIERRE1.Value) & " : "
    If BoxPIERRE2.Value <> "" Then BoxPIERRE2.Value = UCase(BoxPIERRE2.Value) & " : "
    If BoxPIERRE3.Value <> "" Then BoxPIERRE3.Value = UCase(BoxPIERRE3.Value) & " : "
    If BoxCARATP1.Value <> "" Then BoxCARATP1.Value = UCase(BoxCARATP1.Value) & " ct"
    If BoxCARATP2.Value <> "" Then BoxCARATP2.Value = UCase(BoxCARATP2.Value) & " ct"
    If BoxCARATP3.Value <> "" Then BoxCARATP3.Value = UCase(BoxCARATP3.Value) & " ct"
 
    Dim numero As Integer
    numero = 1 'Numéro de départ (correspond ici au n° de ligne)
    While numero <= Q 'TANT QUE la variable numero est <= Q, la boucle est répétée
'Je veux que ma réference QR CODE soit entierement en CAPS, même si les données saisies sont mixtes
    Sheets("DATAQR").Cells(numero, 1) = "C:\zint\zint -b 58 --scale=1 --sec=2 --vers=1 -o QRbar" & numero & ".png -d " & UCase(BoxReference.Value & Chr(45) & BoxSize.Value & Chr(45) & GravureNo & Right(NumGrav, 4))
    Sheets("LABEL").Cells(numero, 1).Offset(1, 0) = UCase(BoxReference.Value & Chr(45) & BoxSize.Value & Chr(45) & GravureNo & Right(NumGrav, 4))
    Sheets("LABEL").Cells(numero, 2).Offset(1, 0) = UCase(BoxMETALTYPE.Value) & " : "
    Sheets("LABEL").Cells(numero, 3).Offset(1, 0) = UCase(BoxPOIDSM1.Value) & " g"
    Sheets("LABEL").Cells(numero, 4).Offset(1, 0) = BoxPIERRE1.Value
    Sheets("LABEL").Cells(numero, 5).Offset(1, 0) = BoxCARATP1.Value
    Sheets("LABEL").Cells(numero, 6).Offset(1, 0) = BoxPIERRE2.Value
    Sheets("LABEL").Cells(numero, 7).Offset(1, 0) = BoxCARATP2.Value
    Sheets("LABEL").Cells(numero, 8).Offset(1, 0) = BoxPIERRE3.Value
    Sheets("LABEL").Cells(numero, 9).Offset(1, 0) = BoxCARATP3.Value
    Sheets("LABEL").Cells(numero, 10).Offset(1, 0) = "C:\\Zint\\QRbar" & numero & ".png"
       numero = numero + 1
       NumGrav = NumGrav + 1
    Wend
'Je lance la création silencieuse d'un fichier TEMP-EXPORTDATAQR.txt contenant mes Références QR CODE dans le répertoire de Zint
    OpenClipboard 0
    EmptyClipboard
    CloseClipboard
 
    Application.ScreenUpdating = False
    Dim temp1 As Workbook
    Set temp1 = Workbooks.Add
    temp1.SaveAs Filename:="C:\ZINT\TEMP1.xls", _
     FileFormat:=xlNormal, CreateBackup:=False
    ThisWorkbook.Sheets("DATAQR").Activate
    ThisWorkbook.Sheets("DATAQR").Range("A1:A1000").Copy
    temp1.Activate
    temp1.Sheets(1).Cells(1, 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ChDir "C:\"
    temp1.SaveAs Filename:="C:\ZINT\TEMP-EXPORTDATAQR.txt", _
     FileFormat:=xlUnicodeText, CreateBackup:=False
    ActiveWorkbook.Close SaveChanges:=False
    ThisWorkbook.Activate
 
'Je vide le presse-papier
    OpenClipboard 0
    EmptyClipboard
    CloseClipboard
 
'Je lance la création silencieuse d'un fichier TEMP-EXPORTLABEL.xlsx contenant mes Références d'étiquettes
    Dim temp2 As Workbook
    Set temp2 = Workbooks.Add
    temp2.SaveAs Filename:="C:\ZINT\TEMP2.xls", _
     FileFormat:=xlNormal, CreateBackup:=False
    ThisWorkbook.Sheets("LABEL").Activate
    ThisWorkbook.Sheets("LABEL").Columns("A:L").Copy
    temp2.Activate
    temp2.Sheets(1).Cells(1, 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ChDir "C:\"
    temp2.SaveAs Filename:="C:\ZINT\TEMP-EXPORTLABEL.xls", _
        FileFormat:=xlNormal, CreateBackup:=False
    ActiveWorkbook.Close SaveChanges:=False
    ThisWorkbook.Activate
    Application.ScreenUpdating = True
 
'Je vide le presse-papier
Set oDataObject = New DataObject
oDataObject.SetText ""
oDataObject.PutInClipboard
Set oDataObject = Nothing
 
Dim Rep As String
Rep = "C:\Zint"
ChDir Rep
Shell "C:\Zint\Conv.bat", vbHide
 
ThisWorkbook.Save
Application.Wait Now + TimeValue("0:00:05")
 
Dim PubliWord As Object
Set PubliWord = New Word.Application
PubliWord.Documents.Open Filename:="C:\Zint\PubliWord.docm"
PubliWord.ActiveDocument.Saved = True
PubliWord.Quit
 
Dim Num As Boolean
'Récupère l'état des LED's
If (&H1 And GetKeyState(vbKeyNumlock)) <> 1 Then Num = False
If Num = False Then 'test si eteint
SendKeys "{NUMLOCK}" 'remet la led en état activé
End If
 
Set PubliWord = Nothing
Set GravureNo = Nothing
Set Q = Nothing
Set NumGrav = Nothing
Set temp1 = Nothing
Set temps2 = Nothing
 
Application.Wait Now + TimeValue("0:00:05")
Shell "C:\Zint\Clean.bat", vbHide
 
BoxReference.Value = ""
    BoxGravure.Value = ""
    BoxQTY.Value = ""
    BoxSize.Value = ""
    BoxDescription.Value = ""
    BoxMETALTYPE.Value = ""
    BoxPOIDSM1.Value = ""
    BoxPIERRE1.Value = ""
    BoxPIERRE2.Value = ""
    BoxPIERRE3.Value = ""
    BoxCARATP1.Value = ""
    BoxCARATP2.Value = ""
    BoxCARATP3.Value = ""
'Je vide la colonne A de la feuille DATAQR
    Sheets("DATAQR").Activate
    Sheets("DATAQR").Columns("A:A") = ""
'Je vide la feuille LABEL
    Sheets("LABEL").Activate
    Sheets("LABEL").Range("A2:A1000") = ""
    Sheets("LABEL").Range("B2:B1000") = ""
    Sheets("LABEL").Range("C2:C1000") = ""
    Sheets("LABEL").Range("D2:D1000") = ""
    Sheets("LABEL").Range("E2:E1000") = ""
    Sheets("LABEL").Range("F2:F1000") = ""
    Sheets("LABEL").Range("G2:G1000") = ""
    Sheets("LABEL").Range("H2:H1000") = ""
    Sheets("LABEL").Range("I2:I1000") = ""
    Sheets("LABEL").Range("J2:J1000") = ""
 
End Sub