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
| Sub LETSGO1_Click()
start = Timer
Application.EnableEvents = False 'activation des procédures événementielles
Application.ScreenUpdating = False 'Désctive le rafraîchissement de l'écran
'Application.Calculation = xlCalculationManual
Dim wSh1 As Worksheet, wSh2 As Worksheet, wSh3 As Worksheet
Dim kR1 As Long, kR2 As Long, k As Long, x As Long
Set wSh1 = ActiveWorkbook.Sheets("COM")
Set wSh2 = ActiveWorkbook.Sheets("TOOL")
Set wSh3 = ActiveWorkbook.Sheets("Q")
kR1 = wSh1.Range("F3").CurrentRegion.Row 'à toi de voir la bonne colonne
For x = 3 To kR1
If wSh1.Cells(x, 22) = "þ" Then '--- 22e colonne
wSh2.Range("X_1") = wSh1.Cells(x, 11)
wSh2.Range("X_2") = wSh1.Cells(x, 12)
wSh2.Range("X_3") = wSh1.Cells(x, 13)
wSh2.Range("X_4") = wSh1.Cells(x, 9)
wSh2.Range(" X_5") = wSh1.Cells(x, 8)
wSh2.Range("X_F1") = wSh1.Cells(x, 14)
wSh2.Range("X_U1") = wSh1.Cells(x, 15)
wSh2.Range("X_S1") = wSh1.Cells(x, 16)
If wSh1.Cells(x, 15) = "MMQ" And wSh1.Cells(x, 16) = "MMQ" Then
kR2 = 13
ElseIf wSh1.Cells(x, 15) = "MMMini/Maxi" And wSh1.Cells(x, 16) = "MMMini/Maxi" Then
kR2 = 14
ElseIf wSh1.Cells(x, 15) = "PMini/Maxi" And wSh1.Cells(x, 16) = "PMini/Maxi" Then
kR2 = 15
Else '--- autre cas
MsgBox vbTab & " Problème syntaxe commande n° " & Cells(x, 6).Value & vbTab & Chr(10) & Chr(10) & "Vérifiez que la ligne de la commande correspond à un PMX, NF ou NS Semi-Standard et que sa codification est correct." & Chr(10) & Chr(10) & vbTab & " !!! La procedure doit être stoppé !!!" & vbTab, , "W.G. MultiCommande Erreur"
Exit Sub
End If
For k = 1 To 5
wSh2.Cells(kR2, 1 + 6 * k) = wSh1.Cells(x, 16 + k)
Next k
Call Module1.Hide_ligne3
Application.EnableEvents = True 'activation des procédures événementielles
Application.ScreenUpdating = True 'Désctive le rafraîchissement de l'écran
'Application.Calculation = xlCalculationAutomatic
'wSh2.PrintPreview '--- aperçu avant impression
'wSh3.PrintPreview '--- aperçu avant impression
'Call Module1.print pdf
'wSh2.PrintOut '--- impression directe
'wSh3.PrintOut '--- impression directe
'Application.EnableEvents = False 'activation des procédures événementielles
'Application.ScreenUpdating = False 'Désctive le rafraîchissement de l'écran
'Application.Calculation = xlCalculationManual
End If
Next x
MsgBox "durée du traitement: " & Timer - start & " secondes"
start = Timer
wSh2.Range("X_F1").Value = "TOTO"
wSh2.Range("X_U1").Value = "U"
wSh2.Range("X_S1").Value = "SOSO"
wSh2.Range("Del_codif").Value = ""
wSh2.Range("Del_cde").Value = ""
Call Module1.Hide_ligne3
Worksheets("COM").Activate
Set wSh1 = Nothing
Set wSh2 = Nothing
Set wSh3 = Nothing
Application.EnableEvents = True 'activation des procédures événementielles
Application.ScreenUpdating = True 'Désctive le rafraîchissement de l'écran
'Application.Calculation = xlCalculationAutomatic
MsgBox "durée du traitement: " & Timer - start & " secondes"
End Sub |
Partager