VBA - Sélectionner un tableau précis de données

Le 29/07/2022 à 09:52

Bonjour,

J'ai essayé de créer un bouton supprimer mais malheureusement sans succès,

En effet c'est une feuille de réglage ou j'ai plusieurs tableau de données à l'intérieur, mais je souhaiterais supprimer l'information d'un seul de ces tableaux spécifiquement,

Voici le code que j'ai mis en place :

Private Sub Supprimer_Click()

Dim J As Long
Worksheets("reglagesemballages").Select
ActiveSheet.ListObjects("raisons_pertes_emballage").Select

If MsgBox("Confirmez-vous la suppression de ce motif ?", vbYesNo, "Demande de confirmation de suppression") = vbYes Then

Rows([G2:G65536].Find(ComboBox1.Value).Row).EntireRow.Delete
raisonspertes.Clear

Set Ws = ActiveSheet.ListObjects("raisons_pertes_emballage")
With Me.raisonspertes
For J = 2 To Ws.Range("G" & Rows.Count).End(xlUp).Row
.AddItem Ws.Range("G" & J)
Next J
End With

End If
End Sub

Je suis sur une des dernières versions excel,

Voici aussi le fichier ci necessaire :

17exemple.xlsm (42.88 Ko)
Le 29/07/2022 à 10:45

Le problème vient que je n'arrive pas à séléctionner mon tableau précisement parmis les autres

J'ai le même soucis avec les autres

Private Sub Enregistrer_Click()

    'Vérifier que la liste n'est pas vide
    If raisonspertes.Value = "" Then
MsgBox "Veuillez renseigner le champs   'Raisons des pertes "
Else

 'Enregister les données du formulaire sur la feuille
Dim ligne As Integer
Worksheets("reglagesemballages").Select
ligne = Sheets("raisons_pertes_emballages").Range("G456541").End(xlUp).Row + 1

'Enregistrer les données dans les cellules
Cells(ligne, 7) = raisonspertes.Value

Sheets("Accueil").Select

    MsgBox "Votre enregistrement a été réalisé"

    Unload FrmEmballage_reglagespertes
    FrmEmballage_reglagespertes.Show

End If

End Sub

Private Sub Modifier_Click()

'Trouver la cellule à modifier
Dim modif As Integer
If Not raisonspertes.Value = "" Then
Sheets("raisons_pertes_emballages").Select
modif = raisonspertes.ListIndex + 1

'Modifier la cellule
Cells(modif, 7) = raisonspertes.Value

Sheets("Accueil").Select

    MsgBox "Votre modification a été réalisé"

    Unload FrmEmballage_reglagespertes
    FrmEmballage_reglagespertes.Show

End Sub

Private Sub Recherche_Click()

'Trouver la cellule ) chercher
If Not raisonspertes.Value = "" Then
    Dim no_ligne As Integer
    no_ligne = raisonspertes.ListIndex + 1
    With Sheets("raisons_pertes_emballages")
        raisonspertes.Value = .Cells(no_ligne, 7).Value
    End With
End If

End Sub
Le 29/07/2022 à 10:48

Bonjour,

Tout d'abord, supprimez l'utilisation de la propriété RowSource de votre Combobox dans la défintion de votre UserForm. A partir du moment où son contenu est modifié à l'exécution, le plantage d'Excel est garanti.

ci-dessous exemple de code adapté à un tableau structuré (classe ListObject) :

Private Sub UserForm_Initialize()

    Chargement_combobox_raison

End Sub

Private Sub Supprimer_Click()

    Dim I As Long, J As Long

    If Me.raisonspertes.ListIndex = -1 Then MsgBox "aucune raison sélectionnée": Exit Sub
    If MsgBox("Confirmez-vous la suppression de cette raison ?", vbYesNo, "Demande de confirmation de suppression") = vbNo Then Exit Sub

    With [raisons_pertes_emballages].ListObject
        I = .ListColumns("Raisons Pertes").DataBodyRange.Find(Me.raisonspertes.Value).Row 'indice ligne dans la feuille
        J = I - .HeaderRowRange.Row 'indice ligne dans le tableau structuré
        .ListRows(J).Delete
    End With

    MsgBox "raison " & Me.raisonspertes & " supprimée"

    Chargement_combobox_raison

End Sub

Sub Chargement_combobox_raison()

    Me.raisonspertes.Clear
    With [raisons_pertes_emballages].ListObject
        If .ListRows.Count = 1 Then Me.raisonspertes.AddItem .ListColumns("Raisons Pertes").DataBodyRange.Value
        If .ListRows.Count > 1 Then Me.raisonspertes.List = .ListColumns("Raisons Pertes").DataBodyRange.Value
    End With

End Sub
Le 29/07/2022 à 11:06

Super merci beaucoup, pour enregistrer une nouvelle ligne dans ce même tableau comment dois-je faire ?

Merci beaucoup !

Le 29/07/2022 à 11:20

Comme ceci, mais d'abord dans votre UserForm, mettez la propriété de votre Combobox : MatchEntry à 2_fmMatchEntryNone :

Private Sub Enregistrer_Click()
    Dim ligne As ListRow
    Dim I As Long

    'Vérifier qu'une valeur a été rentrée sans sélection de la combobox
    If raisonspertes.Value = "" Or Me.raisonspertes.ListIndex > -1 Then MsgBox "Veuillez renseigner le champ 'Raisons des pertes ": Exit Sub

     'Enregister les données du formulaire dans le tableau structuré
    With [raisons_pertes_emballages].ListObject
        Set ligne = .ListRows.Add   'ajout nouvelle ligne à la fin du tableau structuré
        I = ligne.Index 'indice nouvelle ligne ajoutée
        .ListColumns("Raisons Pertes").DataBodyRange(I) = Me.raisonspertes.Value
    End With

    Sheets("Accueil").Select

    MsgBox "Votre enregistrement a été réalisé"

    Me.raisonspertes = Empty
    Chargement_combobox_raison

End Sub
Le 29/07/2022 à 11:28

D'accord merci énormément pour votre aide !

Le 29/07/2022 à 11:37

Et pour la modification

Dim I_modif As Long

Private Sub UserForm_Initialize()

    Chargement_combobox_raison

End Sub

Private Sub raisonspertes_Change()

     If Me.raisonspertes.ListIndex > -1 Then I_modif = Me.raisonspertes.ListIndex + 1

End Sub

Private Sub Modifier_Click()
    Dim I As Long

    'Vérifier qu'une valeur a été sélectionnée de la combobox
    If I_modif = 0 Then MsgBox "Aucune valeur sélectionnée ": Exit Sub

     'Enregister la modification dans le tableau structuré
    With [raisons_pertes_emballages].ListObject
        I = I_modif 'indice ligne sélectionnée
        .ListColumns("Raisons Pertes").DataBodyRange(I) = Me.raisonspertes.Value
    End With

    MsgBox "Votre modification a été réalisée"

    I_modif = 0
    Me.raisonspertes = Empty
    Chargement_combobox_raison

End Sub
Le 29/07/2022 à 13:14

Merci beaucoup, cela fonctionne lorsque je n'ai qu'une information à enregistrer, modifier ou supprimer

Mais lorsque je souhaite modifier, enregistrer plusieurs informations cela ne fonctionne pas,

J'ai essaye de mettre en place un outil recherche pour mes plus gros tableau mais le code que je connais ne fonctionne pas dans cette situation

Si nécessaire je vous mets ci-joint le dossier à jour

Private Sub Modifier_Click()
    Dim I As Long

    'Vérifier qu'une valeur a été sélectionnée de la combobox
    If I_modif = 0 Then MsgBox "Aucune valeur sélectionnée ": Exit Sub

     'Enregister la modification dans le tableau structuré
    With [raisons_pertes_emballages].ListObject
        I = I_modif 'indice ligne sélectionnée
        .ListColumns("Tyoe d'Emballage").DataBodyRange(I) = Me.typeemballage.Value
        .ListColums("Code").DataBodyRange(I) = Me.codeinterne.Value
        .ListColums("Dénomination").DataBodyRange(I) = Me.denomination.Value
        .Listecolums("Description").DataBodyRange(I) = Me.description.Value
        .Listecolums("Référence").DataBodyRange(I) = Me.refproduit.Value
        .Listecolums("Conformité").DataBodyRange(I) = Me.conformite.Value

    End With

    MsgBox "Votre modification a été réalisée"

    I_modif = 0

    Unload FrmEmballage_reglagesprodemb
    FrmEmballage_reglagesprodemb.Show

End Sub

Private Sub Spin_SpinUp()
    .ListColumns("Code").DataBodyRange.Find(Me.codeinterne.Value).Row 1  'indice ligne dans la feuille
    .HeaderRowRange.Row 'indice ligne dans le tableau structuré
End Sub

Private Sub Spin_SpinDown()
    .ListColumns("Code").DataBodyRange.Find(Me.codeinterne.Value).Row -1 'indice ligne dans la feuille
    .HeaderRowRange.Row 'indice ligne dans le tableau structuré
End Sub

Private Sub Supprimer_Click()

    Dim I As Long, J As Long

    If Me.codeinterne.ListIndex = -1 Then MsgBox "aucun produit sélectionné": Exit Sub
    If MsgBox("Confirmez-vous la suppression de ce produit ?", vbYesNo, "Demande de confirmation de suppression") = vbNo Then Exit Sub

    With [societes_emballages].ListObject
        I = .ListColumns("Code").DataBodyRange.Find(Me.codeinterne.Value).Row 'indice ligne dans la feuille
        J = I - .HeaderRowRange.Row 'indice ligne dans le tableau structuré
        .ListRows(J).Delete
    End With

    MsgBox "Produits " & Me.codeinterne & " supprimé"

    Unload FrmEmballage_reglagesprodemb
    FrmEmballage_reglagesprodemb.Show

End Sub

Private Sub Enregistrer_Click()

    Dim ligne As ListRow
    Dim I As Long

    'Vérifier qu'une valeur a été rentrée sans sélection de la combobox
    If codeinterne.Value = "" Or Me.codeinterne.ListIndex > -1 Then MsgBox "Veuillez renseigner le champ 'Raisons des pertes ": Exit Sub

     'Enregister les données du formulaire dans le tableau structuré
    With [base_emballage].ListObject
        Set ligne = .ListRows.Add   'ajout nouvelle ligne à la fin du tableau structuré
        I = ligne.Index 'indice nouvelle ligne ajoutée
        .ListColumns("Tyoe d'Emballage").DataBodyRange(I) = Me.typeemballage.Value
        .ListColums("Code").DataBodyRange(I) = Me.codeinterne.Value
        .ListColums("Dénomination").DataBodyRange(I) = Me.denomination.Value
        .Listecolums("Description").DataBodyRange(I) = Me.description.Value
        .Listecolums("Référence").DataBodyRange(I) = Me.refproduit.Value
        .Listecolums("Conformité").DataBodyRange(I) = Me.conformite.Value
    End With

    Sheets("Accueil").Select

    MsgBox "Votre enregistrement a été réalisé"

    Unload FrmEmballage_reglagesprodemb
    FrmEmballage_reglagesprodemb.Show

End Sub

Merci d'avance et encore !

Le 29/07/2022 à 18:44
Si nécessaire je vous mets ci-joint le dossier à jour
Oui. Joignez votre classeur à jour.
Le 29/07/2022 à 23:12

Bonsoir,

1- Dans ThisWorkbook, définissez la variable publique : nom_formulaire

Public nom_formulaire As String

2- Exemple de code pour votre base emballages

Dim I_modif As Long

Private Sub UserForm_Initialize()

    ThisWorkbook.nom_formulaire = Me.Name

    With [base_emballages].ListObject
        Me.Spin.Max = .ListRows.Count
    End With

    Chargement_combobox_code

End Sub

Private Sub codeinterne_Change()

     If Me.codeinterne.ListIndex > -1 Then I_modif = Me.codeinterne.ListIndex + 1: Afficher_emballage

End Sub

Private Sub Spin_SpinUp()
    I_modif = Me.Spin.Value
    Afficher_emballage
End Sub

Private Sub Spin_SpinDown()
    I_modif = Me.Spin.Value
    Afficher_emballage
End Sub

Private Sub Enregistrer_Click()

    Dim ligne As ListRow
    Dim I As Long

    'Vérifier qu'une valeur a été rentrée sans sélection de la combobox
    If codeinterne.Value = "" Or Me.codeinterne.ListIndex > -1 Then MsgBox "Veuillez renseigner le champ 'Code interne ": Exit Sub

     'Enregister les données du formulaire dans le tableau structuré
    With [base_emballages].ListObject
        Set ligne = .ListRows.Add   'ajout nouvelle ligne à la fin du tableau structuré
        I = ligne.Index 'indice nouvelle ligne ajoutée
        .ListColumns("Type d'Emballage").DataBodyRange(I) = Me.typeemballage.Value
        .ListColumns("Code").DataBodyRange(I) = Me.codeinterne.Value
        .ListColumns("Dénomination").DataBodyRange(I) = Me.denomination.Value
        .ListColumns("Description").DataBodyRange(I) = Me.Description.Value
        .ListColumns("Référence").DataBodyRange(I) = Me.refproduit.Value
        .ListColumns("Conformité").DataBodyRange(I) = Me.conformite.Value
    End With

    Sheets("Accueil").Select

    MsgBox "Votre enregistrement a été réalisé"

    Unload Me
    UserForms.Add(ThisWorkbook.nom_formulaire).Show

End Sub

Private Sub Modifier_Click()
    Dim I As Long

    'Vérifier qu'une valeur a été sélectionnée de la combobox
    If I_modif = 0 Then MsgBox "Aucune valeur sélectionnée ": Exit Sub

     'Enregister la modification dans le tableau structuré
    With [base_emballages].ListObject
        I = I_modif 'indice ligne sélectionnée
        .ListColumns("Type d'Emballage").DataBodyRange(I) = Me.typeemballage.Value
        .ListColumns("Code").DataBodyRange(I) = Me.codeinterne.Value
        .ListColumns("Dénomination").DataBodyRange(I) = Me.denomination.Value
        .ListColumns("Description").DataBodyRange(I) = Me.Description.Value
        .ListColumns("Référence").DataBodyRange(I) = Me.refproduit.Value
        .ListColumns("Conformité").DataBodyRange(I) = Me.conformite.Value

    End With

    MsgBox "Votre modification a été réalisée"

    I_modif = 0

    Unload Me
    UserForms.Add(ThisWorkbook.nom_formulaire).Show

End Sub

Private Sub Supprimer_Click()

    Dim I As Long, J As Long

    If Me.codeinterne.ListIndex = -1 Then MsgBox "aucun produit sélectionné": Exit Sub
    If MsgBox("Confirmez-vous la suppression de ce produit ?", vbYesNo, "Demande de confirmation de suppression") = vbNo Then Exit Sub

    With [base_emballages].ListObject
        I = .ListColumns("Code").DataBodyRange.Find(Me.codeinterne.Value).Row 'indice ligne dans la feuille
        J = I - .HeaderRowRange.Row 'indice ligne dans le tableau structuré
        .ListRows(J).Delete
    End With

    MsgBox "Produits " & Me.codeinterne & " supprimé"

    Unload Me
    UserForms.Add(ThisWorkbook.nom_formulaire).Show

End Sub

Sub Chargement_combobox_code()

    Me.codeinterne.Clear
    With [base_emballages].ListObject
        If .ListRows.Count = 1 Then Me.codeinterne.AddItem .ListColumns("Code").DataBodyRange.Value
        If .ListRows.Count > 1 Then Me.codeinterne.List = .ListColumns("Code").DataBodyRange.Value
    End With

End Sub

Sub Afficher_emballage()
    If I_modif = 0 Then Exit Sub

    With [base_emballages].ListObject
        Me.codeinterne.Value = .ListColumns("Code").DataBodyRange(I_modif)
        Me.typeemballage.Value = .ListColumns("Type d'Emballage").DataBodyRange(I_modif)
        Me.denomination.Value = .ListColumns("Dénomination").DataBodyRange(I_modif)
        Me.Description.Value = .ListColumns("Description").DataBodyRange(I_modif)
        Me.refproduit.Value = .ListColumns("Référence").DataBodyRange(I_modif)
        Me.conformite.Value = .ListColumns("Conformité").DataBodyRange(I_modif)
    End With

End Sub
Le 02/08/2022 à 10:20

Merci beaucoup tout fonctionne

Seule problème j'ai plusieurs userform et différent document sur ce classeur

Lorsque je fais Userform Inilaze cela me fait tout planter je dois tout reprendre

Et le problème c'est lorsque je saisie une premiere fois et que ça s'ajoute au tableau, après les lignes suivantes s'incrémente, mais elle ne prolonge pas le tableau :/

Le 06/08/2022 à 20:30
Lorsque je fais Userform Inilaze cela me fait tout planter je dois tout reprendre
C'est très certainement dû à l'utilisation de la propriété RowSource dans la définition de vos ComboBox. A partir du moment où leur contenu est modifié à l'exécution, le plantage d'Excel est garanti.
Rechercher des sujets similaires à "vba selectionner tableau precis donnees"