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