Listobject - Add row sans faire foirer tout ce qui se trouve dans la sheet

Bonjour,

Je vous sollicite car une fois de plus, je suis face à un problème que je n'arrive pas à résoudre...

J'utilise des tables dans des feuilles. Ces tables se trouvent bien souvent les unes au dessus des autres. J'aimerais créer une fonction qui permet d'ajouter une ligne à la table sans pour autant faire foirer tout ce qui se trouve en dessous de celle-ci. Comment vous y prendriez-vous?

Voici le code que j'utilise pour le moment mais qui ne résout pas le problème des lignes inférieures à la table...

Sub subname (ctab As String, sheetn as String)
  Dim ob As ListObject, lastrow As Integer, rc As Integer, fr As Integer
    Set ob = Worksheets(sheetn).ListObjects(ctab)
            rc = Range(ctab).Rows.Count '#of rows in table
            fr = Range(ctab).Row 'First row in table coordinate
            Rows(fr + rc + 1).Insert 'Insert row below table
            ob.ListRows.Add , AlwaysInsert:=false 'Add line to table
End Sub

D'avance un tout grand merci,

Nathan

Bonjour,

Les tables(pseudo BD) et Tableaux structurés devraient être seules dans une feuille dédiées.

Les tables de paramètres peuvent se trouver dans une feuille commune sur la première ligne et espacées les unes des autres par une colonne vide !

A+

Bonjour,

En complément de la réponse de Galopin, ci-dessous le code approprié :

Sub subname(ctab As String)
    Dim ob As ListObject, ligne As ListRow, i As Integer

    Set ob = Range(ctab).ListObject
    Set ligne = ob.ListRows.Add 'Add line to table
    i = ligne.Index 'line number
    With ob
        .ListColumns("titre_colonne").DataBodyRange(i) = valeur
    End With

End Sub

Correctif :

Set ob = Range(ctab).ListObject

Bonjour,
Une autre proposition.
Cette disposition de tableaux est à éviter !...
Cdlt.

Public Sub InsertRowInTable(tableName As String, sheetName As String)
Dim lo As ListObject, n As Long
    Set lo = ActiveWorkbook.Worksheets(sheetName).ListObjects(tableName)
    n = lo.HeaderRowRange.Row + lo.ListRows.Count + 1
    Worksheets(sheetName).Cells(n, 1).EntireRow.Insert -4121
    lo.Resize lo.Range.Resize(n - lo.HeaderRowRange.Row + 1)
End Sub

Un tout grand merci, cette dernière solution fonctionne.

Puis-je demander pourquoi le -4121?

Bonjour,

Ma solution fonctionne aussi avec le correctif apporté ci-dessus.

Sub subname(ctab As String)
    Dim ob As ListObject, ligne As ListRow, i As Integer

    Set ob = Range(ctab).ListObject
    Set ligne = ob.ListRows.Add 'Add line to table
End sub

Re,
-4121 = xlShiftDown
C'est une constante de direction, qui va imposer Excel d'insérer une ligne vers le bas.
Sans précision, Excel agit en fonction de la plage !...
Cdlt.

Bonsoir…

Une proposition (voire 2) avec 3 tableaux* dans le même onglet !

*Ici les nouveaux tableaux (qui commencent à dater) nous permettent de grandes simplifications grâce à leurs nouvelles propriétés mais ils ont aussi leurs limites. Par exemple, en cas de problème de position on peut n’avoir pas de solution donnée, seulement un message d’erreur ! On doit avoir le réflexe de les déplacer (Copier/ Couper/Coller voire Glissement avec la souris) sans besoin de transformations.

Nota : pour ajouter une ligne passer par R.ListObject.ListRows.Add (L)

Bonjour à toutes et tous.
Une alternative à la proposition d'Ordonc.
Bonne journée.
Cdlt.

Private Sub Worksheet_SelectionChange(ByVal R As Range)
Dim lo As ListObject, lRow As Long
    If Not R.ListObject Is Nothing And R.CountLarge = 1 Then
        Set lo = R.ListObject
        If lo.InsertRowRange Is Nothing Then
            If Not Intersect(R, lo.DataBodyRange) Is Nothing Then
                lRow = R.Row - lo.HeaderRowRange.Row
                If MsgBox("Souhaitez vous supprimer la ligne " & lRow & " du tableau " & lo.Name & " ?", _
                        4, "Suppression ligne...") = vbYes Then
                    lo.ListRows(lRow).Range.Delete
                End If
            End If
        End If
    End If
End Sub