Re : [VBA]Code pour cases à cocher choix multiple apparaissant dans le tableau !
Re,
après modifs, le fichier dépasse la limite acceptée sur le forum
copie le code ci-dessous et colle afin de remplacer ton ancien code
Private Sub cmdajouter_Click()
Dim numlignevide As Integer
'activation de la feuille "Prêt BluRay"
Worksheets("Prêt BluRay").Activate
'trouve la dernière ligne vide du tableau et enregistre le numéro de la ligne dans la variable numlignevide
numlignevide = ActiveSheet.Columns(1).Find("").Row
'vérifie que les champs obligatoires sont correctement remplis
If txtfilm.Text = "" Then
MsgBox "Veuillez rentrez le nom d'un film.", vbCritical, "Important"
txtfilm.SetFocus
Else
'enregistre les données
ActiveSheet.Cells(numlignevide, 1) = UCase(txtfilm.Text)
ActiveSheet.Cells(numlignevide, 4) = txtpret.Text
End If
If option1 = True Then
ActiveSheet.Cells(numlignevide, 3) = "Oui"
ElseIf option2 = True Then
ActiveSheet.Cells(numlignevide, 3) = "Non"
ActiveSheet.Cells(numlignevide, 4) = "En stock !"
End If
If cbaction = True Then
ActiveSheet.Cells(numlignevide, 2) = ActiveSheet.Cells(numlignevide, 2) & "Action "
End If
If cbanim = True Then
ActiveSheet.Cells(numlignevide, 2) = ActiveSheet.Cells(numlignevide, 2) & "Animation "
End If
If cbaven = True Then
ActiveSheet.Cells(numlignevide, 2) = ActiveSheet.Cells(numlignevide, 2) & "Aventure "
End If
If cbcom = True Then
ActiveSheet.Cells(numlignevide, 2) = ActiveSheet.Cells(numlignevide, 2) & "Comédie "
End If
If cbcomdra = True Then
ActiveSheet.Cells(numlignevide, 2) = ActiveSheet.Cells(numlignevide, 2) & "Comédie-Dramatique "
End If
If cbdocu = True Then
ActiveSheet.Cells(numlignevide, 2) = ActiveSheet.Cells(numlignevide, 2) & "Documentaire "
End If
If cbdrame = True Then
ActiveSheet.Cells(numlignevide, 2) = ActiveSheet.Cells(numlignevide, 2) & "Drame "
End If
If cbahor = True Then
ActiveSheet.Cells(numlignevide, 2) = ActiveSheet.Cells(numlignevide, 2) & "Horreur "
End If
If cbfan = True Then
ActiveSheet.Cells(numlignevide, 2) = ActiveSheet.Cells(numlignevide, 2) & "Fantastique "
End If
If cbguerre = True Then
ActiveSheet.Cells(numlignevide, 2) = ActiveSheet.Cells(numlignevide, 2) & "Guerre "
End If
If cbhisto = True Then
ActiveSheet.Cells(numlignevide, 2) = ActiveSheet.Cells(numlignevide, 2) & "Historique "
End If
If cbmusic = True Then
ActiveSheet.Cells(numlignevide, 2) = ActiveSheet.Cells(numlignevide, 2) & "Musical "
End If
If cbpoli = True Then
ActiveSheet.Cells(numlignevide, 2) = ActiveSheet.Cells(numlignevide, 2) & "Policier "
End If
If cbrom = True Then
ActiveSheet.Cells(numlignevide, 2) = ActiveSheet.Cells(numlignevide, 2) & "Romance "
End If
If cbsf = True Then
ActiveSheet.Cells(numlignevide, 2) = ActiveSheet.Cells(numlignevide, 2) & "Science-Fiction "
End If
If cbthriller = True Then
ActiveSheet.Cells(numlignevide, 2) = ActiveSheet.Cells(numlignevide, 2) & "Thriller "
End If
If cbhor = True Then
ActiveSheet.Cells(numlignevide, 2) = ActiveSheet.Cells(numlignevide, 2) & "Epouvante-Horreur "
End If
txtfilm.Text = ""
txtpret.Text = ""
option1 = False
option2 = True
'efface le formulaire et replace le curseur sur txtfilm
cbaction = False
cbanim = False
cbaven = False
cbcom = False
cbcomdra = False
cbdocu = False
cbdrame = False
cbhor = False
cbfan = False
cbguerre = False
cbhisto = False
cbmusic = False
cbpoli = False
cbrom = False
cbsf = False
cbthriller = False
txtfilm.Text = ""
txtpret.Text = ""
option1 = False
option2 = True
txtfilm.SetFocus
End Sub
les puristes diront que je pouvais simplifier mais ça te permettra de comprendre le cheminement
à+
.