Bonjour
peut-être auriez-vous la solution à mon problème.
Tous les jours des données sont entrées en ligne dans un tableau (1 ligne par jour avec une dizaine de données). Ces données doivent être validées donc j'ai mis pour cela une checkbox à la fin de chaque ligne qui active une étape de validation (copier coller de la ligne et transfert de certaines données vers une autre feuille).
Mon but était évidemment de faire une macro unique et non une macro par jour.
Là où je me suis fait avoir je pense, c'est que je peut pas associer le code de macro à plusieurs checkbox....
Mon code fonctionne bien mais n'est utilisable que sur une seule checkbox
Si vous avez une solution pour que mon code fonctionne sur plusieurs checkbox, je suis preneur!
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 Private Sub CheckBox1_Click() Dim jour As Integer 'On Error GoTo Sortir Application.ScreenUpdating = False 'RECUPERATION DE LA LIGNE DU JOUR 'CHAQUE CELLULE DE VALIDATION EST LIEE A UNE CELLULE DE LA COLONNE AB Set ctrl = ActiveSheet.Shapes("CheckBox1").OLEFormat.Object ActiveSheet.Range(ctrl.LinkedCell).Select jour = ActiveCell.Row 'MsgBox (jour) 'DEVEROUILLAGE DE LA PAGE PAR MDP ActiveSheet.Unprotect 'LES MESURES DU JOUR SONT FIGEES PAR UN COPIER-COLLER DE VALEURS Range(Cells(jour, 2), Cells(jour, 23)).Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False 'LES ECARTS SONT REPORTES DANS LA CARTE DE SUIVI With ActiveSheet Set DDJ = .Range("B" & jour) Set Ecart_X6 = .Range("E" & jour) Set Ecart_X25 = .Range("H" & jour) Set Ecart_E6 = .Range("K" & jour) Set Ecart_E8 = .Range("N" & jour) Set Ecart_E10 = .Range("Q" & jour) Set Ecart_E12 = .Range("T" & jour) Set Ecart_E15 = .Range("W" & jour) End With Worksheets("Carte").Activate Sheets("Carte").Range("B5").EntireRow.Insert DDJ.Copy ActiveSheet.Paste Destination:=ActiveSheet.Range("B5") Ecart_X6.Copy ActiveSheet.Paste Destination:=ActiveSheet.Range("C5") Ecart_X25.Copy ActiveSheet.Paste Destination:=ActiveSheet.Range("D5") Ecart_E6.Copy ActiveSheet.Paste Destination:=ActiveSheet.Range("E5") Ecart_E8.Copy ActiveSheet.Paste Destination:=ActiveSheet.Range("F5") Ecart_E10.Copy ActiveSheet.Paste Destination:=ActiveSheet.Range("G5") Ecart_E12.Copy ActiveSheet.Paste Destination:=ActiveSheet.Range("H5") Ecart_E15.Copy ActiveSheet.Paste Destination:=ActiveSheet.Range("I5") Application.ScreenUpdating = True 'Sortir:: Exit Sub End Sub
Merci d'avance pour votre aide
Physmed
Partager