Réalisation un ComboBox avecliste déroulante permettant de filter dynamiqu

j'ai call trier comme demander, et aussi mis le code dans un nouveau module .en testant j'ai cette erreur

erreur 438 place code

le message ne me dit rien.

Le code s'arrête où ?
La ligne de l'erreur doit être surlignée en jaune en principe

Vous cliquez depuis la feuille HOME ?

cette code qui est souligné

ligne erreur

Ok. Vérifiez si le nom de votre USF est bien orthographié --> UsFSaisieLivraison

Vous accédez à l'USF comment ? depuis l'usf saisiecorrective ?


Sinon faite un test comme ceci :
- positionnez votre souris sur la ligne Sub ouvrir_usfsaisielivraison
- appuyez sur F8 pour avancer dans le code en mode pas à pas (si vous être sur un portable il se peut que vous deviez appuyer sur FN +F8)
Le code va surligner chaque ligne en jaune. Il vous suffit d'appuyer chaque fois sur la touche F8 pour passer d'une ligne à l'autre
Là vous allez voir où le code plante.
Donnez-moi la ligne à problème

Voici , c'est à cette endroit que le code se plante

plante du probleme

Ok.
Vérifiez ceci :
1. La feuille MOULES est bien orthographiée ?
2. Dans votre feuille MOULES vous avez bien CODE MOULE en A9 ?
3. Enlevez le chiffre 2 derrière le ADD

c'est ok maintenant quand j'ai enlever le 2.

merci infiniment

Ok. c'est dingue le nombre de fois que l'on a ce souci avec le chiffre 2

On passe à l'USF suivante

1. Code initialize

Private Sub UserForm_Initialize()

Call Trier

Me.ComboCode.List = Range("CodeMoule").ListObject.DataBodyRange.Value
With Sheets("INFO DIV")
    Me.ComboSection.List = .Range("section").Value
    Me.CombotypeIntervention.List = .Range("TYPE_D_INTERVENTION").Value
End With
End Sub

2. Code combocode

Private Sub ComboCode_Change()
Dim ligne As Integer

Me.TextEquipement = vbNullString
If Me.ComboCode.Value = vbNullString Then Exit Sub

With Range("CodeMoule").ListObject
    On Error Resume Next
    ligne = WorksheetFunction.Match(Me.ComboCode.Value, .ListColumns(1).DataBodyRange.Value, 0)
    If ligne = 0 Then MsgBox "Code inexistant", vbCritical, "Erreur code": Me.ComboCode.Value = vbNullString: Exit Sub
    Me.TextEquipement = .DataBodyRange(ligne, 2).Value
End With
End Sub

3. Vous avez une petit faute d'ortographe sur le code SAISIE_LIVRASON_Click et donc sur le nom du bouton. Peut être à corriger ?

Faites un test, pour voir si ok

Restera le code enregistrement

Ok c'est bon, le test est sans problème !

oui c'est sans problèmes

Ok. Dans la sub initialize de mon post précédent, vous pouvez supprimer Dim cel as range. Cela ne sert pas. J'ai corrigé dans mon post précédent

A. Code enregistrement
1. Vous devez définir tous les noms "histo_mois" (les mois doivent être nommés comme dans le code ci-dessous)
2. remplacez le code Enregistrer de l'USF par celui ci-dessous

Private Sub CmdEnregistrer_Click()
Dim mois As Byte
Dim lig As Integer
Dim sh As String

If Me.TextDate.Value = "" Then MsgBox "Aucune date saisie", vbCritical, "Saisie date": Exit Sub

On Error Resume Next
mois = Month(CDate(Me.TextDate.Value))
Select Case mois
    Case 1: sh = "JANVIER"
    Case 2: sh = "FEVRIER"
    Case 3: sh = "MARS"
    Case 4: sh = "AVRIL"
    Case 5: sh = "MAI"
    Case 6: sh = "JUIN"
    Case 7: sh = "JUILLET"
    Case 8: sh = "AOUT"
    Case 9: sh = "SEPTEMBRE"
    Case 10: sh = "OCTOBRE"
    Case 11: sh = "NOVEMBRE"
    Case 12: sh = "DECEMBRE"
    Case Else
        MsgBox "Mois non Valide", vbCritical, "Erreur mois"
        Exit Sub
End Select
On Error GoTo 0

'Enregistrer les donnees sur la feuille
With Range("histo_" & sh).ListObject
    If .ListRows.Count = 0 Then 'trouver si ligne dans tableau structuré
        .ListRows.Add: lig = 1 'si pas de ligne
    Else: .ListRows.Add: lig = .ListRows.Count 'si lignes trouvees
    End If
    With .DataBodyRange
        .Item(lig, 1) = CDate(Me.TextDate.Value) 'DATE
        .Item(lig, 2) = Me.ComboCode.Value 'CODE
             '.item(lig,3) = 'EQUIPEMENT
        .Item(lig, 4) = Me.ComboSection.Value 'SECTION
        .Item(lig, 5) = Me.CombotypeIntervention.Value 'TYPE INTERVENTION
        .Item(lig, 6) = Me.TextDI.Value 'N0° BON INTERVENTION
        .Item(lig, 7) = Me.TextAnomalie.Value 'ANOMALIE CONSTATEE
        .Item(lig, 8) = Me.TextRapport.Value 'RAPPORT D'INTERVENTION
        .Item(lig, 9) = Me.TextPiecesderechange.Value 'PIECES DE RECHANGE UTILISEES
        .Item(lig, 10) = CDate(Me.TextDebutIntervention.Value) 'DATE & HEURE DEBUT  INTERVENTION
        .Item(lig, 11) = CDate(Me.TextFinIntervention.Value) 'DATE & HEURE FIN INTERVENTION
        .Item(lig, 15) = Me.TextNomsExecutants.Value 'EXECUTANTS
        .Item(lig, 16) = Me.TextObsevation.Value 'Observation
    End With
    MsgBox "Données enregistrées avec succès", vbInformation, "Enregistrement"
End With
End Sub

B. Code Effacer --> Le code Private Sub CmdEffacer_Click() est identique à celui de l'USF Livraison. Il vous suffit de faire un copier-coller dans cette USF

NB : on aurait pu aussi faire un seul code pour définir la variable sh pour l'enregistrement dans les deux USF. Mais bon cela fonctionne aussi comme cela. C'est juste que quelques fois, éviter les redondances est intéressant.

rem : il restera à
- savoir si vous voulez vous garder la fermeture des USF via la croix en plus du code lié au bouton FERMER. Cela ne gêne pas d'avoir les deux évidemment
- voir si les codes dans les module 1 à 3 servent ou pas

j'ai corrigé noms 'HISTO_MOIS' partout . mais le code se plante à ce niveau.

planter 02

Vous y mettez quoi dans cette textbox ? une date ?

On y ajoute la date et l'heure

date et heure

Modifiez la ligne comme ceci

        .Item(lig, 10) = Format(CDate(Me.TextDebutIntervention.Value), "dd/mm/yyyy hh:mm") 'DATE & HEURE DEBUT  INTERVENTION

si ok, modifiez aussi la ligne suivante pour la date de fin

c'est tjrs planté à ce niveau

planter 03

donnez-moi ce que vous y mettez exactement.

j'ai mis ceci par exemple --> 15/01/24 9:00 et là cela fonctionne
Vérifiez le nom des textbox aussi

pour le moment ca ne marche pas,

je vais aller pour une intervention. si je trouve le disfonctionnement après; je vous le ferrai part.

merci beaucoup pour votre disponibilité et votre gentillesse.

Cordialement

Bonjour!

j'ai reparcourue tous, mais j'ai pas trouver la ou ca se ne vas pas.

j'ai essayé ces codes ci dessous et ca a marché.

Private Sub CmdEnregistrer_Click()
Dim sh As Worksheet
Dim mois As Integer
Dim lig As Integer

If Me.TextDate.Value = "" Then MsgBox ("Aucune date saisie"): Exit Sub
On Error Resume Next
mois = Month(CDate(Me.TextDate.Value))

Select Case mois 'selectionner les feuille en fonction du mois.
Case 1: Set sh = ThisWorkbook.Sheets("JANVIER")
Case 2: Set sh = ThisWorkbook.Sheets("FEVRIER")
Case 3: Set sh = ThisWorkbook.Sheets("MARS")
Case 4: Set sh = ThisWorkbook.Sheets("AVRIL")
Case 5: Set sh = ThisWorkbook.Sheets("MAI")
Case 6: Set sh = ThisWorkbook.Sheets("JUIN")
Case 7: Set sh = ThisWorkbook.Sheets("JUILLET")
Case 8: Set sh = ThisWorkbook.Sheets("AOUT")
Case 9: Set sh = ThisWorkbook.Sheets("SEPTEMBRE")
Case 10: Set sh = ThisWorkbook.Sheets("OCTOBRE")
Case 11: Set sh = ThisWorkbook.Sheets("NOVEMBRE")
Case 12: Set sh = ThisWorkbook.Sheets("DECEMBRE")
Case Else
MsgBox "Mois non Valide"
Exit Sub
End Select
For lig = 10 To 214
If sh.Range("A" & lig) = "" Then Exit For
Next
'Enrégistrer les données sur la feuille sélectionnée

sh.Range("A" & lig) = CDate(Me.TextDate.Value) 'DATE
sh.Range("B" & lig) = Me.ComboCode.Value 'CODE
'sh.Range("C" & lig) = 'EQUIPEMENT
sh.Range("D" & lig) = Me.ComboSection.Value 'SECTION
sh.Range("E" & lig) = Me.CombotypeIntervention.Value 'TYPE INTERVENTION
sh.Range("F" & lig) = Me.TextDI.Value 'N0° BON INTERVENTION
sh.Range("G" & lig) = Me.TextAnomalie.Value 'ANOMALIE CONSTATEE
sh.Range("H" & lig) = Me.TextRapport.Value 'RAPPORT D'INTERVENTION
sh.Range("I" & lig) = Me.TextPiecesderechange.Value 'PIECES DE RECHANGE UTILISEES
sh.Range("j" & lig) = Format(CDate(Me.TextDebutIntervention.Value), "dd/mm/yyyy hh:mm") 'DATE & HEURE DEBUT INTERVENTION
sh.Range("k" & lig) = Format(CDate(Me.TextFinIntervention.Value), "dd/mm/yyyy hh:mm") 'DATE & HEURE FIN INTERVENTION
sh.Range("o" & lig) = Me.TextNomsExecutants.Value 'EXECUTANTS
sh.Range("P" & lig) = Me.TextObsevation.Value 'O

MsgBox "Données enregistrées avec succès"

End Sub

merci beaucoup pour votre soutien,

pour finir, je vœux insérer un code pour empêcher qu'on puisse enregistrer si un des cases n'ai pas renseigné avec un message de notification "veuillez renseigner tous les cases vides".

Cordialement

Bonjour

Pensez à utiliser les balises de code lorsque vous postez un code en cliquant sur l'icone </> dans la barre de menu et en collant le code dans la fenetre. j'ai corrigé votre post


Cela n'a pas de sens. Vous faites une boucle inutile et vous revenez à vos anciens codes qui ne sont pas à utiliser avec tableaux au format structuré
Vous avez juste une ligne qui ne fonctionne pas sur la date et l'heure qui pose problème
Je ne vois pas pourquoi ce que je vous ai proposé ne fonctionne pas sachant que l'on suit la même ligne que dans le code Livraison. Il y a une chose que vous n'avez pas faite car ce que je vous ai proposé fonctionne très bien dans votre fichier où j'ai refait le code
Pouvez-vous me donner votre ficher que je regarde ou alors je vous donne le fichier de travail ?


EDIT

pour finir, je vœux insérer un code pour empêcher qu'on puisse enregistrer si un des cases n'ai pas renseigné avec un message de notification "veuillez renseigner tous les cases vides".

Ok je regarde ce point.

Rechercher des sujets similaires à "realisation combobox avecliste deroulante permettant filter dynamiqu"