Discussion :

[r0man0]

Bonjour,
j'aimerai pouvoir lancer une macro à partir d'un bouton en fonction de cases cochées,
Je post un print écran, avec explication.case à cocher bouton et macro-couper.jpg
Il y a sur la gauche 6 items track tous différent, en haut j'ai 2 boutons commandant mes macros principales, 6 correspondant à mes 6 items pour le premier bouton et 6 correspondant également à mes 6 items pour le second. Et en bas à droite j'ai un autre bouton important "transformation" qui comme les précédent aura 6 macros. Concernant mes 6 items, je leur ai désigné 6 case, j'aimerai que par exemple le "track 5" étant coché, lance la macro qui lui est attribué quand je vais cliquer sur "1/transfert" et "2/generation". Ainsi de suite pour les autres items. Voilà est ce suffisamment claire.
J'ai un exemple de macro que j'utilise, j'aimerai l'associer à mon premier item " track 1 " quand je coche la case, et la lancer quand je clique sur " transformation " et ainsi de suite pour les autres macro...
Voilà cette fameuse macro, elle est un peu brut de décoffrage, et demande à être allégé.

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
 
Sub TRANSFO()
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Open Filename:="D:\SING.xls"
Range("A:A,T:T,U:U,V:V,W:W").Replace What:=" - ", Replacement:="@", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Range("C:C,E:E,F:F,H:H,I:I,J:J,K:K,L:L,O:O,P:P,Q:Q ,R:R,S:S,X:X,Y:Y,AA:AA,AB:AB,AC:AC,AD:AD,AE:AE,AG: AG,AH:AH").Delete Shift:=xlToLeft
Columns("L:L").Copy
Columns("Z:Z").Select
ActiveSheet.Paste
Columns("A:A").TextToColumns Destination:=Range("L1"), DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="@", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Columns("G:G").TextToColumns Destination:=Range("M1"), DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="@", FieldInfo:=Array(Array(1, 2), Array(2, 1)), TrailingMinusNumbers:=True
Columns("H:H").TextToColumns Destination:=Range("N1"), DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="@", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Columns("I:I").TextToColumns Destination:=Range("P1"), DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="@", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Columns("J:J").TextToColumns Destination:=Range("R1"), DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="@", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Range("A:A,G:G,H:H,I:I,J:J,N:N,P:P,R:R").Delete Shift:=xlToLeft
Range("L2").FormulaR1C1 = "=CONCATENATE(C[-4],"" "",C[-2],"" "",C[-3],"" "",C[-6],"" "",C[-1],"" "",C[-5],"" "",C[-9],"" "",C[-11])"
Range("L2").AutoFill Destination:=Range("L2:L65000")
Columns("C:C").Cut
Columns("M:M").Insert Shift:=xlToRight
Range("B:B,C:C,D,K:K,L:L,R:R").Copy
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Paste
Columns("D").Select
'Cells.Replace What:=" /", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:=",", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
'Cells.Replace What:="(", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
'Cells.Replace What:=")", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.AutoFilter
ActiveWorkbook.Worksheets("Feuil1").AutoFilter.Sor t.SortFields.Clear
ActiveWorkbook.Worksheets("Feuil1").AutoFilter.Sor t.SortFields.Add Key:=Range("A1:A65000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Feuil1").AutoFilter.Sor t
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A2").Copy
Windows("OUTILS WORK IN PROGRESS.xls").Activate
Range("M36").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Windows("SING.xls").Activate
Columns("B:E").Copy
Windows("OUTILS WORK IN PROGRESS.xls").Activate
Columns("A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("SING.xls").Activate
Sheets("Feuil1").Select
Sheets("Feuil1").Copy
ChDir "D:\03"
ActiveWorkbook.SaveAs Filename:= _
"D:\03\SING_Save.xls", FileFormat:= _
xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Windows("SING.xls").Close
Windows("SING_Save.xls").Close
Columns("A").AutoFilter
ChDir "D:\SING"
ActiveWorkbook.SaveAs Filename:= _
"D:\SING.xls", FileFormat:=xlExcel8, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox ("Chargement SING terminé")
End Sub

Cordialement.