[VBA]Code pour cases à cocher choix multiple apparaissant dans le tableau !

[benbeto]

Bonjour,

Voila j'ai un tableau de base de données ou je veux mettre mes films, j'ai fait un formulaire ou je rentre le nom du film, si prêté (oui/non), à qui?, et je veux rajouter plusieurs cases à cocher pour les genres (action, horreur, etc...).

J'ai donc fait ça :



Le truc que je voudrais c'est que lorsque je sélectionne plusieurs genre (par exemple pour un film comme "Matrix" je choisi "Action" et "Science fiction", les deux choix soit bien indiquer sur le tableau dans la colonne "Genre".

J'ai essayer mais j'arrive uniquement à faire apparaître un seul des choix sinon il y a une erreur.

Voila le code que j'ai taper :

If cbaction = True Then
ActiveSheet.Cells(numlignevide, 2) = "Action"
ElseIf cbanim = True Then
ActiveSheet.Cells(numlignevide, 2) = "Animation"

De plus, lorsque je valide mon formulaire, celui-ci s'efface pour pouvoir enregistrer un nouveau film mais grise les cases (que ce soit les cases pour le genre ou la case "oui") je ne sais pas comment faire pour éviter ça.

Je montre ce que cela fait quand je valide le formulaire :



Merci

 

[phlaurent55]

Re : [VBA]Code pour cases à cocher choix multiple apparaissant dans le tableau !

Bonjour benbeto,

si tu pouvais nous joindre un bout de fichier au lieu des tes images illisibles ce serait plus aisé pour te répondre

à+
.

 

[benbeto]

Re : [VBA]Code pour cases à cocher choix multiple apparaissant dans le tableau !

Comment ça un bout de fichier ?

jpeux pas envoyer mon fichier excel il est trop volumineux si c'est ça que tu voulais dire.

sinon je peux te mettre le code que j'ai taper, (tu verras j'ai commencer avec une méthode super longue et laborieuse, j'aimerais trouver une autre solution car sinon j'en ai pour 1 semaine pour tout rentrer ^^)

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

If option1 = True Then
ActiveSheet.Cells(numlignevide, 3) = "Oui"

ElseIf option2 = True Then
ActiveSheet.Cells(numlignevide, 3) = "Non"
ActiveSheet.Cells(numlignevide, 4) = "En stock !"

If cbaction = True Then
ActiveSheet.Cells(numlignevide, 2) = "Action"

End If

'la je paramêtre chaque possibilités pour les cases à cocher, méthode ultra longue en attendant de trouver une astuce pour un code plus léger
'premiere session en partant de la case Action

If cbaction And cbanim = True Then
ActiveSheet.Cells(numlignevide, 2) = "Action, Animation"
End If
If cbaction And cbanim And cbaven = True Then
ActiveSheet.Cells(numlignevide, 2) = "Action, Animation, Aventure"
End If
If cbaction And cbanim And cbaven And cbcom = True Then
ActiveSheet.Cells(numlignevide, 2) = "Action, Animation, Aventure, Comédie"
End If
If cbaction And cbanim And cbaven And cbcom And cbcomdra = True Then
ActiveSheet.Cells(numlignevide, 2) = "Action, Animation, Aventure, Comédie, Comédie dramatique"
End If


End If

'efface le formulaire et replace le curseur sur txtfilm

cbaction = ""
cbanim = ""
cbaven = ""
cbcom = ""
cbcomdra = ""
cbdocu = ""
cbdrame = ""
cbhor = ""
cbfan = ""
cbguerre = ""
cbhisto = ""
cbmusic = ""
cbpoli = ""
cbrom = ""
cbsf = ""
cbthriller = ""
txtfilm.Text = ""
txtpret.Text = ""
option1 = ""
option2 = True

txtfilm.SetFocus

End If

End Sub

 

[phlaurent55]

Re : [VBA]Code pour cases à cocher choix multiple apparaissant dans le tableau !

Re,

jpeux pas envoyer mon fichier excel il est trop volumineux si c'est ça que tu voulais dire.

ce serait quand même plus facile pour te répondre

ce que tu demandes est réalisable
Tout d'adord:
Fais l'effort de joindre un bout de fichier contenant le minimun
avec explications claires ( de préférences sur la feuille )
contenant quand-même l'Usf

ça nous évitera de passer du temps tout construire et permettra de donner une réponse qui correspondra exactement à ta demande

à+
.

 

[phlaurent55]

Re : [VBA]Code pour cases à cocher choix multiple apparaissant dans le tableau !

Re,

If cbaction And cbanim = True Then
ActiveSheet.Cells(numlignevide, 2) = "Action, Animation"
End If
If cbaction And cbanim And cbaven = True Then
ActiveSheet.Cells(numlignevide, 2) = "Action, Animation, Aventure"
End If
If cbaction And cbanim And cbaven And cbcom = True Then
ActiveSheet.Cells(numlignevide, 2) = "Action, Animation, Aventure, Comédie"
End If
If cbaction And cbanim And cbaven And cbcom And cbcomdra = True Then
ActiveSheet.Cells(numlignevide, 2) = "Action, Animation, Aventure, Comédie, Comédie dramatique"
End If

pour tout ceci, tu t'embarques dans qq chose dont tu ne t'en sortira pas
sans avoir vu ton fichier, je pense que
ActiveSheet.Cells(numlignevide, 2) = ActiveSheet.Cells(numlignevide, 2) & " ton type de film"

à+

 

[benbeto]

Re : [VBA]Code pour cases à cocher choix multiple apparaissant dans le tableau !

ok voila j'ai fait un zip de mon fichier excel !

merci pour ton aide

 

[phlaurent55]

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
à+
.

 

[benbeto]

Re : [VBA]Code pour cases à cocher choix multiple apparaissant dans le tableau !

Super ! Merci beaucoup ça fonctionne niquel !

J'ai compris le principe franchement c'est top !

J'ai d'autre idées pour amélioré ce projet, vu que tu as mon fichier sous la main tu pourras peut-être m'aider =.

En fait, j'aimerais faire à côté des boutons en haut (voir films prêté, rechercher film etc...) comme une liste déroulante ou je pourrais choisir parmi les genres existant. Le but c'est d'afficher uniquement les films du genre choisi dans la liste déroulante.

Alors des listes déroulante je sais faire mais la pour ce cas bien précis je vois pas trop comment faire sachant que admettons pour "Matrix" que je le classe dans "Action" et "Science fiction" au départ lorsque je le rajoute via le formulaire, et que par la suite (avec la future liste déroulante), je choisisse "Action", il faudrait qu'il le trouve bien qu'il y ait inscrit "Action" et "Science fiction" dans la colonne "Genre"

Je sais pas tu tu saisis mon idées ^^!

 

[phlaurent55]

Re : [VBA]Code pour cases à cocher choix multiple apparaissant dans le tableau !

Re,

Je sais pas tu tu saisis mon idées

je saisis................... mais je suis incapable de le faire
je pense qu'il te faudra passer par les tableaux croisés dynamiques mais le fait de mettre le(s) genre(s) du film dans une seule et même cellule risque de te poser quelques problèmes

Patience, le forum regorge de ténors qui pourrons t'aider
Bonne fin de journée
à+
Philippe

 

[benbeto]

Re : [VBA]Code pour cases à cocher choix multiple apparaissant dans le tableau !

Oui voila je pense que c'est assez compliqué j'espère trouver une solution sur ce forum ou ailleurs.

Merci pour ton aide en tout cas je posterais la solution quand j'en aurais une.

(Mais si quelqu'un peut m'aider je dit pas non bien sur hein! )

a + tard phlaurent55.

 

[phlaurent55]

Re : [VBA]Code pour cases à cocher choix multiple apparaissant dans le tableau !

Re,

une solution serait d'ajouter des colonnes ( une par genre de film) dans lesquelles les cellules contiendraient par exemple 1 ou 0 et t'en servir pour filtrer tes données

à+

 

[benbeto]

Re : [VBA]Code pour cases à cocher choix multiple apparaissant dans le tableau !

Oui c'est une solution mais je veux pas avoir autant de colonnes et avec des 1 ou 0 (c'est juste une question d'esthétique pour mon tableau ^^)

Mais à la limite si je trouve pas de solution je ferais 1 ou 2 colonnes supplémentaires ou je mettrai le genre n°2 et n°3 comme ça je pourrais faire des listes déroulante plus simplement je pense....à voir.

 

[phlaurent55]

Re : [VBA]Code pour cases à cocher choix multiple apparaissant dans le tableau !

Re,

Oui c'est une solution mais je veux pas avoir autant de colonnes et avec des 1 ou 0 (c'est juste une question d'esthétique pour mon tableau ^^)

Rien ne t'empêche d'ajouter une douzaine de colonnes ET de les masquer afin de ne pas les afficher ce qui ne changera absolument rien à l'esthétique.
tu peux ajouter tes colonnes du coté droit de ta feuille et/ou mettre la couleur du texte à l'identique du fond de cellule afin de ne plus les voir

Courage faut pas se laisser abattre
à+
Philippe
.