Ajout de valeurs dans un tableau stucturé spécifique, Erreur Objet Range

Le 22/07/2021 à 09:41
36mef.xlsm (35.73 Ko)

Bonjour,

Je suis en stage et je suis bloqué depuis quelques temps. J'ai une feuille Excel nommé "MEF" qui comporte 7 tableaux (le nbr de tab pourra varier avec le temps). J'ai un bouton "ajouter", qui lorsqu'on clique dessus, un formulaire s'ouvre avec une combobox avec tous les noms des tableaux et une Textbox avec la valeur à mettre. Lorsqu'on a choisi les deux champs, ces valeurs se mettent dans une listView du formulaire qui comporte deux colonnes "nom tab" et "valeurs". A la fin, lorsqu'on clique sur valider du formulaire, toutes les lignes de la listView se mettent dans les différents tableaux choisi.

J'ai réussi à tout faire sauf l'ajout dans les différents tableaux, j'ai une erreur lors de l'exécution, "La méthode Value de l'Objet Range a échoué" . Je ne comprend pas d'où viens cette erreur. De plus, le nom des colonnes de ma listView ne s'affiche pas alors que j'ai mis "ListView1.View = lvwReport" lors de l'initialisation.

Mon code pour l'instant est :

Private Sub AjoutLigneDansListView1_Click()
    ' ---- AJOUT VAL DES TEXTBOX ET COMBOBOX DANS LISTVIEW -----
    If Me.TextBox1.Value <> "" And Me.ComboBox1 <> "" Then
        Me.ListView1.ListItems.Add 1, , Me.ComboBox1.Value
        Me.ListView1.ListItems(1).ListSubItems.Add 1, , Me.TextBox1.Value
    Else
        MsgBox " Les champs doivent ?tre remplis"
    End If

    Me.ComboBox1 = ""
    Me.TextBox1 = ""

End Sub

Private Sub Annuler_Click()
    Dim alerte As Integer
    alerte = MsgBox("Etes vous sure de vouloir quitter ?" & Chr(10) & "(si vous quittez toutes les lignes remplis seront perdus) ", vbYesNo + vbCritical)
    If alerte = vbYes Then

        Unload Me
    End If
End Sub

Private Sub CommandButton1_Click()

        ' ---- AJOUT DES LIGNES DE LA LISTVIEW DANS TAB EXCEL -----

        Application.CutCopyMode = False
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        Application.DisplayStatusBar = False
        Application.EnableEvents = False

        Dim i As Integer
        Dim a As Integer
        Dim alerte As Integer
        Dim dl As Integer
        Dim objListObjTab As ListObject
        Dim objListRowsTab As ListRows
        Dim objListColsTab As ListColumns
        Dim objListRng As Range

        If ListView1.ListItems.Count >= 1 Then
            alerte = MsgBox("Etes vous sure de vouloir rajouter ces lignes", vbYesNo)
            If alerte = vbYes Then
                'Pour chaque ligne de la listView
                For i = 1 To ListView1.ListItems.Count
                    Set objListObjTab = Sheets("MEF").ListObjects(ListView1.ListItems(i).Text)
                    Set objListRowsTab = objListObjTab.ListRows
                    Set objListColsTab = objListObjTab.ListColumns
                    nbrlgtab = objListRowsTab.Count

                    'objListObjTab.Range(nbrlgtab + 2, 1) = ListView1.ListItems(i).ListSubItems(1).Text
                    'Set objListRng = objListObjTab.InsertRowRange

                    'objListRowsTab.Item(nbrlgtab).Range.Select
                    'Selection.ListObject.ListRows.Add AlwaysInsert:=True

                    'If objListRng Is Nothing Then
                    '    ActivateInsertRow = False
                    'Else
                    '    objListRng.Activate
                    '    ActivateInsertRow = True
                    'End If

                    'objListObjTab.ShowTotals = False
                    'MsgBox objListObjTab.Range(nbrlgtab + 2, 1).Address

                    'MsgBox nbrlgtab
                    'Sheets("MEF").ListObjects(ListView1.ListItems(i).Text).Cells(nbrLgTab + 2, 1) = ListView1.ListItems(i).ListSubItems(1).Text
                    'ListView1.ListItems.Remove (ListView1.ListItems(i).Index)
                    'ComboBox1 = ""
                    'TextBox1 = ""

                    'Sheets("MEF").ListObjects(ListView1.ListItems(i).Text).ListRows.Add  'Je rajoute une liste dans le tab voulu
                    'a = Sheets("MEF").ListObjects(ListView1.ListItems(i).Text).Range.Rows.Count - 1 ' Je compte la derni?re ligne du tab voulu
                    'Sheets("MEF").ListObjects(ListView1.ListItems(i).Text).ListRows(a).Range.Value = ListView1.ListItems(i).ListSubItems(1).Text                     'Je rajoute le texte a la fin du tab voulu
                Next i
                'Unload Me
            End If
        Else
            alerte = MsgBox("Vous devez au moins ajouter une ligne", vbOKOnly + vbCritical)
        End If
        'Ici on remet les ?lement du d?but ? Vrai
        Application.CutCopyMode = True
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        Application.DisplayStatusBar = True
        Application.EnableEvents = True

End Sub

Private Sub UserForm_Activate()
    ActiveSheet.Unprotect
End Sub

Private Sub UserForm_Initialize()
    Dim nomTab As ListObject
    For Each nomTab In Sheets("MEF").ListObjects
        ComboBox1.AddItem (nomTab)
    Next
    'ici on d?finit les ent?tes des colonnes de la listView
    With Me.ListView1
        With .ColumnHeaders
            .Clear
            .Add 1, , "Nom tableau", 115
            .Add 2, , "Valeur", 115

        End With

    End With

    'Ici on rend visible les ent?tes et on donne la possibilit? de s?lectionner une ligne enti?re
    ListView1.View = lvwReport
    ListView1.FullRowSelect = True
    ListView1.FlatScrollBar = False

End Sub

Les lignes en commentaire dans la fonction Private Sub CommandButton1_Click() sont des essais qui on rien donné, où qui génère des erreurs. J'ai déposé en pièce jointe un exemple du fichier.

Cordialement.

Le 22/07/2021 à 10:11

Bonjour,

Est-ce que c'est cette ligne que vous cherchez :

Set objListRng = objListObjTab.databodyRange

Cdlt,

Le 22/07/2021 à 10:14

Bonjour,

ci-dessous votre code corrigé et simplifié

Private Sub CommandButton1_Click()

        Dim i as integer
        Dim tableau As ListObject
        Dim ligne As ListRow

        ' ---- AJOUT DES LIGNES DE LA LISTVIEW DANS TAB EXCEL -----

        Application.ScreenUpdating = False

        If ListView1.ListItems.Count >= 1 Then
            If MsgBox("Etes vous sure de vouloir rajouter ces lignes", vbYesNo) = vbNo Then Exit Sub

            With ListView1
                'Pour chaque ligne de la listView
                For i = 1 To .ListItems.Count
                    Set tableau = Feuil1.ListObjects(.ListItems(i).Text)
                    With tableau
                        Set ligne = .ListRows.Add
                         .ListColumns(1).DataBodyRange.Rows(ligne.Index) = ListView1.ListItems(i).ListSubItems(1).Text
                    End With
                Next i
            End With

            Unload Me
        Else
            MsgBox "Vous devez au moins ajouter une ligne", vbOKOnly + vbCritical
        End If

        'Ici on remet les élement du début à Vrai
        Application.ScreenUpdating = True

End Sub
Le 22/07/2021 à 10:17

Bonjour à tous

Avec des tableaux d'une colonne, ceci suffit

Private Sub CommandButton1_Click()

        ' ---- AJOUT DES LIGNES DE LA LISTVIEW DANS TAB EXCEL -----

        Application.CutCopyMode = False
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        Application.DisplayStatusBar = False
        Application.EnableEvents = False

        Dim j As Integer
        Dim alerte As Integer
        Dim y As Long
        Dim objListObjTab As ListObject

        If ListView1.ListItems.Count >= 1 Then
            alerte = MsgBox("Etes vous sure de vouloir rajouter ces lignes", vbYesNo)
            If alerte = vbYes Then
                'Pour chaque ligne de la listView
                For i = 1 To ListView1.ListItems.Count
                    Set objListObjTab = Sheets("MEF").ListObjects(ListView1.ListItems(i).Text)
                    For j = 1 To ListView1.ListItems(i).ListSubItems.Count
                        y = objListObjTab.ListRows.Add.Index
                        objListObjTab.DataBodyRange.Cells(y, 1) = ListView1.ListItems(i).ListSubItems(j).Text
                    Next j
                Next i
                Unload Me
            End If
        Else
            alerte = MsgBox("Vous devez au moins ajouter une ligne", vbOKOnly + vbCritical)
        End If
        'Ici on remet les élement du début à Vrai
        Application.CutCopyMode = True
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        Application.DisplayStatusBar = True
        Application.EnableEvents = True

End Sub

Edit : oups grillé par Thev

Le 22/07/2021 à 10:34

Bonjour,

J'ai dû ajouter la référence Microsoft Windows Common Controls 6.0 (SP6) ???

Pour l'ajour de lignes :

For i = 1 To ListView1.ListItems.Count
    Set lo = Sheets("MEF").ListObjects(ListView1.ListItems(i).Text)
    With lo
        If .InsertRowRange Is Nothing Then
            Set r = .HeaderRowRange.Cells(1).Offset(.ListRows.Count + 1)
        Else
            Set r = .InsertRowRange.Cells(1)
        End If
    End With
    r.Value = ListView1.ListItems(i).ListSubItems(1).Text
Next i
24mef.xlsm (37.99 Ko)
Le 22/07/2021 à 10:54
errrrrrrrrrr2 errrr c1 c3 c4

Bonjour,

Merci pour vos réponse, j'ai testé toutes vos versions mais j'ai toujours cette même erreur. Cela marche dans le fichier test que j'ai mis en pièce jointe mais pas sur mon vrai fichier. Je ne comprend pas.

Oui, dans les contrôle supplémentaire j'ai plein de chose coché et je ne sais pas vraiment à quoi tout cela correspond, j'ai peut être des erreurs à ce niveau là.

Le 22/07/2021 à 11:16

Bonjour,

Dans l'éditeur VB, aller à Outils --> Références et regarder si une référence n'est pas manquante. Auquel cas, la décocher et la remplacer par celle présente dans votre version.

Vérifiez également que vous n'employez pas la propriété "RowSource" pour vos tableaux structurés.

Le 22/07/2021 à 12:14

Salut,

Une bonne pratique.

  • Toujours compiler son code après modification. (Souvent l'erreur n'est pas là où on l'attends)
  • Bien déterminer Option Explicit en tête de module. (Cela évite moultes problèmes)
  • Supprimer les références qui ne servent pas dans le projet.
  • Vérifier et inscrire les références avec Regsvr ex: %systemroot%\syswow64\Regsvr32 "D:\Compléments\MSCOMCT2.OCX"

...

Le 22/07/2021 à 13:20

Bonjour,

D'accord, merci tout le monde pour vos conseils, je vais essayer tout ça.

Bonne journée !

Rechercher des sujets similaires à "ajout valeurs tableau stucture specifique erreur objet range"