lier case à cocher à checkbox

kesmus

XLDnaute Nouveau
Bonsoir,
SVP, avec votre permission, veuillez m'aider pour lier plusieurs case à cocher se trouvant dans toutes les feuilles à checkbox dans une userform svp
 

kesmus

XLDnaute Nouveau
Re

Et au cas où il faudrait mettre plutôt les Formes
alors c'est plutôt comme cela qu'il faudrait faire
VB:
Private Sub CheckBox1_Click()
Dim WS As Worksheet, cb As Shape
For Each WS In Worksheets
For Each cb In WS.Shapes
    If cb.Type = msoFormControl Then
        If cb.FormControlType = 1 Then
        cb.OLEFormat.Object.Value = CheckBox1
        End If
    End If
Next cb
Next
End Sub
Mais comme on a toujours pas de fichier exemple, m'en vais mettre mon pyjama et me brosser les quenottes.

Bonne nuit à tous
 

kesmus

XLDnaute Nouveau
Bonsoir
Merci encore, comme vous l'avez demandé, ci-joint tout mon projet qui se présente ainsi :
Code:
Sub page2()
Dim MonEleve
Sheets("param").Select
MonEleve = Range("B4").Value
Sheets(MonEleve).Select
Range("A1").Select
End Sub
Sub page1()
Dim MonEleve
On Error Resume Next
If Range("A28").Value = 1 Then
Sheets("param").Select
MonEleve = Range("B4").Value
Sheets(MonEleve).Select
Range("A1").Select
End If
End Sub
Sub Page_Preced()
On Error Resume Next
ActiveSheet.Previous.Select
Range("A1").Select
End Sub
Sub Page_Suiv()
On Error Resume Next
If ActiveSheet.Range("S8").Value < ActiveSheet.Range("R8").Value Then
ActiveSheet.Next.Select
Range("A1").Select
Else
Range("N1").Select
End If
End Sub
Sub Page_Suiv2()
On Error Resume Next
ActiveSheet.Next.Select
Range("B1").Select
End Sub
Sub Calculatrice()
Application.ActivateMicrosoftApp Index:=0
End Sub
Sub PSWD()
ThisWorkbook.Sheets("Accueil").Select
Dim MyDate0, MyDate1, MyDate2, Dernier, i As Integer, j As Integer
MyDate0 = Range("A27").Value
MyDate1 = Range("A32").Value
MyDate2 = Range("A31").Value
If Range("C31").Value = 0 Then
MsgBox ("Tentative de réouverture du Programme échouée !")
Exit Sub
End If
If Range("A31").Value = "" Then
MsgBox ("Veuillez demander l'autorisation du développeur")
Application.Quit
End If
If Range("A29").Value >= 3 Then
MsgBox ("Vous n'êtes plus autorisé à accéder à ce programme")
Application.Quit
End If
If Range("D29").Value = Range("U30").Value Or Range("D29").Value = 1439 Then
Application.ScreenUpdating = False
ThisWorkbook.Unprotect (1439)
Range("A28").Value = 1
Dernier = Range("P29").Value
'---------------------------
For i = 55 To 42 Step -1
Sheets(i).Visible = True
Next i
For j = 1 To Dernier Step 1
Sheets(j).Visible = True
Next j
'---------------------------
Else
MsgBox ("Clé d'accès non valide !")
Range("A29").Value = Range("A29").Value + 1
End If
ThisWorkbook.Protect Password:=(1439)
End Sub
Sub MasquerLignes()
ThisWorkbook.Worksheets("Param").Unprotect ("???")
If Range("E4").Value = 1 Then
Range("A1").Offset(0, 0).Select
Selection.EntireRow.Hidden = True
Range("E4").Value = 0
Else
Range("A1").Offset(0, 0).Select
Selection.EntireRow.Hidden = False
Range("E4").Value = 1
End If
Range("B6").Select
ThisWorkbook.Worksheets("Param").Protect Password:=("???")
End Sub
Sub MasquerColonne()
ActiveSheet.Unprotect ("???")
If Range("A9").Value = 1 Then
Columns("V:BI").Hidden = True
Columns("B:U").Hidden = False
Range("B11").Select
End If
If Range("A9").Value = 2 Then
Columns("V:AO").Hidden = False
Columns("B:U").Hidden = True
Columns("AP:BI").Hidden = True
Range("V11").Select
End If
If Range("A9").Value = 3 Then
Columns("B:AO").Hidden = True
Columns("AP:BI").Hidden = False
Range("AP11").Select
End If
ActiveSheet.Protect Password:=("???")
End Sub
Sub Raz_Tab()
On Error Resume Next
If Range("C30").Value = 1439250449 Then
Application.ScreenUpdating = False
Sheets("100").Select
Range("B11:U50").Value = ""
Sheets("200").Select
Range("B11:U50").Value = ""
Sheets("300").Select
Range("B11:U50").Value = ""

Sheets("1000").Select
Range("B11:U50").Value = ""
Range("V11:AO50").Value = ""
Range("AP11:BI50").Value = ""

Sheets("2000").Select
Range("B11:U50").Value = ""
Range("V11:AO50").Value = ""
Range("AP11:BI50").Value = ""

Sheets("3000").Select
Range("B11:U50").Value = ""
Range("V11:AO50").Value = ""
Range("AP11:BI50").Value = ""

Sheets("Accueil").Select
Range("C30").Select
End If
End Sub
'----------------------------------
Sub ProtDeprot()
Application.ScreenUpdating = False
For i = 1 To 40
'Worksheets(i).Unprotect Password:="???"
Worksheets(i).Protect Password:="???"
Next i
End Sub
'----------------------------------
Sub SimulNote1()
Dim MyValue, j As Integer, k As Integer
If Sheets("Accueil").Range("C30").Value = 1439250449 Then
Range("B11").Select
For k = 0 To 19 Step 1
Range("B11").Offset(0, k).Select
If Range("B11").Offset(-7, k).Value > 0 Then
j = Range("B1").Value - 1
For i = 0 To 39 Step 1
MyValue = ((j * Rnd) + 0.5)
ActiveCell.Offset(i, 0).Value = MyValue
Next i
End If
Next k
End If
End Sub
Sub SimulNote2()
Dim MyValue, j As Integer, k As Integer
If Sheets("Accueil").Range("C30").Value = 1439250449 Then
Range("V11").Select
For k = 0 To 19 Step 1
Range("V11").Offset(0, k).Select
If Range("V11").Offset(-7, k).Value > 0 Then
j = Range("V1").Value - 1
For i = 0 To 39 Step 1
MyValue = ((j * Rnd) + 0.5)
ActiveCell.Offset(i, 0).Value = MyValue
Next i
End If
Next k
End If
End Sub
Sub SimulNote3()
Dim MyValue, j As Integer, k As Integer
If Sheets("Accueil").Range("C30").Value = 1439250449 Then
Range("AP11").Select
For k = 0 To 19 Step 1
Range("AP11").Offset(0, k).Select
If Range("AP11").Offset(-7, k).Value > 0 Then
j = Range("AP1").Value - 1
For i = 0 To 39 Step 1
MyValue = ((j * Rnd) + 0.5)
ActiveCell.Offset(i, 0).Value = MyValue
Next i
End If
Next k
End If
End Sub
Sub Impression()
On Error Resume Next
Msg = "Voulez-vous vraiment imprimer TOUS les Bulletins ?"
Style = vbYesNo + vbCritical + vbDefaultButton1
Title = "IMPRESSION DES BULLETINS"
Réponse = MsgBox(Msg, Style, Title)
If Réponse = vbYes Then
GoTo continu
Else
Exit Sub
End If
continu:
Dim mafeuille As Object
Application.ScreenUpdating = False
Set monTab = Worksheets(Array("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"))
For Each mafeuille In monTab
mafeuille.Select
Note = Range("G30").Value
If Note > 0 Then
ActiveSheet.PageSetup.PrintArea = "$A$2:$S$63"
ActiveWindow.SelectedSheets.PrintOut Copies:=1
End If
Next
End Sub
 

kesmus

XLDnaute Nouveau
sur chaque feuille d'excel, (au nombre de 40), j'ai prévu 03 cases à cocher .
Maintenant ce que je souhaiterais faire, c'est de pouvoir afficher sur une userform (checkbox) l'état des cases à cocher.
Je ne sais pas est ce que c'est explicite ou non.
à votre disposition pour tout complément d'information
mes remerciement les plus sincères.
 

Statistiques des forums

Discussions
312 922
Messages
2 093 654
Membres
105 777
dernier inscrit
Lili1411