suprimer un listobject du sheets avant de le reconstruire

Version imprimable

bonjour

comme le titre l'indique je souhaiterais supprime litéralement un tableau structuré avant de le reconstruire ainsi qu'enlever tout modification couleur ou format dans les cellules

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub test()
    entete = Array("toto", "titi", "riri", "fifi", "loulou", "truc", "bidule", "machin", "chose")
    new_nom = "pannel1"
    nbligne = 6
    Themes = "truc bidule" & Date & "/" & "machin"
    With ActiveSheet
        .Cells(Rows.Count, 1).End(xlUp).Offset(1) = Themes
        '************************************************************************************
        'ici je voudrais le supprimer si il existe ainsi que tout mise en couleur ou format sur la plage occupée par le tableau
        ' tout a partir du themes
        '************************************************************************************
        .ListObjects.Add(xlSrcRange, .Cells(Rows.Count, 1).End(xlUp).Offset(2).Resize(6, UBound(entete) + 1), , xlNo).Name = new_nom
        .ListObjects("pannel1").TableStyle = "TableStyleMedium11"
        With Range("pannel1[#Headers]")
            .Value = entete
            .Interior.Color = RGB(0, 100, 0)
            .Font.Color = vbWhite
        End With
        'model d'acces a une colonne :
        'MsgBox Range(new_nom & "[titi]").Address
    End With
End Sub

quelqu'un sait faire ca ?

Bonjour,

D'après l'aide
Code:

1 2 3 Sub DeList() ActiveWorkbook.Worksheets("feuil1").ListObjects(1).Unlist End Sub
Boisgontier

18/03/2019, 09h17
patricktoulon

re

merci jacques
c'est pas aussi simple ;)
c'est de ma faute ,j'ai oublié de donner des renseignements

cette sub est multiplié par X avec new_nom et themes etc.. qui change a chaques fois

ce que je voudrais au final c'est supprimer carrément les lignes car je ne refait pas toujours les tableaux dans l'ordre et il y en a 8
en effet quand je fait ce tableau je peux en faire un ou plusieur apres et revenir sur celui la pour le supprimer ligne comprise afin d'eviter d'avoir des plage vides
en gros il faudrait que je cerne la derniere cellule du tableau et la cellule du themes et cette plage.entirerow doit etre literalement supprimée

Supprime complétement le tableau

Code:

1
2
3
4
5
Sub DeList()
 Set temp = ActiveWorkbook.Worksheets("feuil1").ListObjects(1).Range
 ActiveWorkbook.Worksheets("feuil1").ListObjects(1).Unlist
 temp.Clear
End Sub

Boisgontier

re
jacques je peux pas chopper les listobject par leur index il sont pas toujours dans le meme ordre du justement a des suppressions anterieurs

j'ai essayé d'adapter mais ca fonctionne pas avec les noms

en gros je doit pouvoir lancer la sub tabl1 36 fois et n'avoir q'un tableau sur le sheet

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub tab1()
    Dim entete, new_nom$, themes, lignes
    entete = Array("toto", "titi", "riri", "fifi", "loulou", "truc", "bidule", "machin", "chose")
    new_nom = "pannel1"
    lignes = 6
    themes = "truc bidule" & Date & "/" & "machin"
    create_tableau entete, new_nom, themes, lignes
End Sub
 
Function create_tableau(entete, new_nom As String, themes As String, lignes As Long)
    With ActiveSheet
        '************************************************************************************
        'ici je voudrais le supprimer si il existe ainsi que tout mise en couleur ou format sur la plage occupée par le tableau
        Set temp = Range(new_nom & "[#All]")
        If Not temp Is Nothing Then
            '.ListObjects(new_nom).Unlist
            Union(temp, temp.Offset(-2)).EntireRow.Delete
        End If
        '************************************************************************************
        .Cells(Rows.Count, 1).End(xlUp).Offset(1) = themes
        .ListObjects.Add(xlSrcRange, .Cells(Rows.Count, 1).End(xlUp).Offset(2).Resize(lignes, UBound(entete) + 1), , xlNo).Name = new_nom
        .ListObjects(new_nom).TableStyle = "TableStyleMedium11"
        With Range(new_nom & "[#Headers]")
            .Value = entete
            .Interior.Color = RGB(0, 100, 0)
            .Font.Color = vbWhite
        End With
        'model d'acces a une colonne :
        'MsgBox Range(new_nom & "[titi]").Address
    End With
End Function

[COTE]les lignes doivent etre supprimées et non clear imperativement [/COTE]
et le tableau doit etre determiné par sont nom et non son index car le panel1 n'aura pas toujours le meme index

Je suppose que tu connais

Code:

1
2
3
4
5
6
7
8
Sub NomsTableauxDynamiques()
  For s = 1 To Sheets.Count
    For Each n In Sheets(s).ListObjects
       tmp = tmp & "/" & n.Name
    Next n
  Next s
  MsgBox tmp
End Sub

Boisgontier

Bonjour,

je te laisse gérer la suppression de ton "themes"

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub tab1()
    Dim entete, new_nom$, themes, lignes
    entete = Array("toto", "titi", "riri", "fifi", "loulou", "truc", "bidule", "machin", "chose")
    new_nom = "Tableaeu1"
    lignes = 6
    themes = "truc bidule" & Date & "/" & "machin"
    create_tableau entete, new_nom, themes, lignes
End Sub
 
Function create_tableau(entete, new_nom As String, ByVal themes As String, ByVal lignes As Long)
Dim Temp As ListObject
    With ActiveSheet
        '************************************************************************************
        'ici je voudrais le supprimer si il existe ainsi que tout mise en couleur ou format sur la plage occupée par le tableau
        On Error Resume Next
            Set Temp = .ListObjects(new_nom).Range
        On Error GoTo 0
        If Not Temp Is Nothing Then Temp.EntireRow.Delete
        '************************************************************************************
        .Cells(Rows.Count, 1).End(xlUp).Offset(1) = themes
        With .ListObjects.Add(xlSrcRange, .Cells(Rows.Count, 1).End(xlUp).Offset(2).Resize(lignes, UBound(entete) + 1), , xlNo)
            .Name = new_nom
            .TableStyle = "TableStyleMedium11"
            With .HeaderRowRange
                .Value = entete
                .Interior.Color = RGB(0, 100, 0)
                .Font.Color = vbWhite
            End With
        End With
    End With
End Function

18/03/2019, 10h18
patricktoulon

re

et oui je m'en doutais c'est soit une boucle sur les tableau soit une gestion d'erreur
pour la suppression de la ligne themes
ca devraitt etre

Code:

Union(temp, temp.Offset(-2)).EntireRow.Delete' puisqu'a la creation le tableau est posé dans l'offset(2)

je vais tester tout ca
merci
18/03/2019, 10h30
patricktoulon

1 pièce(s) jointe(s)

re

@Joe:coucou:
une demo parle mieux que les mots
pas de message donc ca match pas pourtant le tableau y est bien et porte bien le bon nom
Pièce jointe 458909
18/03/2019, 10h33
joe.levrai

Je ne vois pas le nom de ton tableau, ni n'arrive à lire ton code

de mon côté, ça fonctionnait très bien avec mon code tel que posé (sauf bien sûr la gestion de la suppression de themes)

que veut Temp après la tentative d'affectation ?

re
test ca
on a bien le range bien déterminé mais la suppression ne se fait pas alors qu'a la main ca le fait
le message ne trompe pas l'adresse est bonne

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub tabx1()
    Dim entete, new_nom$, themes, lignes
    entete = Array("toto", "titi", "riri", "fifi", "loulou", "truc", "bidule", "machin", "chose")
    new_nom = "panel1"
    lignes = 6
    themes = "truc bidule" & Date & "/" & "machin"
    create_tableau entete, new_nom, themes, lignes
End Sub
Function create_tableau(entete, new_nom As String, ByVal themes As String, ByVal lignes As Long)
    Dim rng As Range, TbS As ListObject
    With ActiveSheet
        '************************************************************************************
        'ici je voudrais le supprimer si il existe ainsi que tout mise en couleur ou format sur la plage occupée par le tableau
        For Each TbS In .ListObjects
            Debug.Print TbS.Name & " : "
            If TbS.Name = new_nom Then Set rng = Union(Range(new_nom & "[#all]"), Range(new_nom & "[#all]").Offset(-2))
        Next
        If Not rng Is Nothing Then MsgBox "range a supprimer : " & rng.Address
        If Not rng Is Nothing Then rng.EntireRow.Delete
        '************************************************************************************
         .Cells(Rows.Count, 1).End(xlUp).Offset(1) = themes
        With .ListObjects.Add(xlSrcRange, .Cells(Rows.Count, 1).End(xlUp).Offset(2).Resize(lignes, UBound(entete) + 1), , xlNo)
            .Name = new_nom
            .TableStyle = "TableStyleMedium11"
            With .HeaderRowRange
                .Value = entete
                .Interior.Color = RGB(0, 100, 0)
                .Font.Color = vbWhite
            End With
        End With
    End With
End Function

puré je m'emboucanne la vie pour ca

18/03/2019, 11h00
patricktoulon

re

joe avec ton exemple la partie on error .... et temp sont passé et l'erreur se declenche a la ligne

Code:

.Name = new_nom

conclusion ta gestion d'erreur ne pointe pas l'erreur pourtant dans la fenetres des names et !! le sheets le tableau(new_nom) y est bien

bon ca y est ca match maintenant

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Sub tabx1()
    Dim entete, new_nom$, themes, lignes
    entete = Array("toto", "titi", "riri", "fifi", "loulou", "truc", "bidule", "machin", "chose")
    new_nom = "panel1"
    lignes = 6
    themes = "truc bidule" & Date & "/" & "machin"
    create_tableau entete, new_nom, themes, lignes
End Sub
Sub tabx2()
    Dim entete, new_nom$, themes, lignes
    entete = Array("vcbgcc", "titi", "riri", "fifi", "loulou", "truc", "bidule", "machin", "chose")
    new_nom = "panel1"
    lignes = 6
    themes = "truc bidule" & Date & "/" & "machin"
    create_tableau entete, new_nom, themes, lignes
End Sub
Function create_tableau(entete, new_nom As String, ByVal themes As String, ByVal lignes As Long)
    Dim rng As Range, TbS As ListObject
    With ActiveSheet
        '************************************************************************************
        'ici je voudrais le supprimer si il existe ainsi que tout mise en couleur ou format sur la plage occupée par le tableau
        For Each TbS In .ListObjects
            Debug.Print TbS.Name & " : "
            If TbS.Name = new_nom Then Set rng = Union(Range(new_nom & "[#all]"), Range(new_nom & "[#all]").Offset(-2))
        Next
        If Not rng Is Nothing Then MsgBox "range a supprimer : " & rng.Address
        If Not rng Is Nothing Then rng.EntireRow.Delete
        '************************************************************************************
         .Cells(Rows.Count, 1).End(xlUp).Offset(1) = themes
        With .ListObjects.Add(xlSrcRange, .Cells(Rows.Count, 1).End(xlUp).Offset(2).Resize(lignes, UBound(entete) + 1), , xlNo)
            .Name = new_nom
            .TableStyle = "TableStyleMedium11"
            With .HeaderRowRange
                .Value = entete
                .Interior.Color = RGB(0, 100, 0)
                .Font.Color = vbWhite
            End With
        End With
    End With
End Function

puré de puré
merci a tous ;)

18/03/2019, 11h08
joe.levrai

J'avais retypé Temp pour une autre écriture, mais pas remis en place quand je t'ai copié le code

Code:

Dim Temp As Range

si on le laisse en Listobject, il faut faire

Code:

Set Temp = .ListObjects(new_nom)

et ensuite

Code:

If Not Temp Is Nothing Then Temp.Range.EntireRow.Delete

j'ai trouvé ton erreur joe

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Function create_tableau(entete, new_nom As String, ByVal themes As String, ByVal lignes As Long)
    Dim Temp As ListObject, rng As Range
    With ActiveSheet
        '************************************************************************************
        'ici je voudrais le supprimer si il existe ainsi que tout mise en couleur ou format sur la plage occupée par le tableau
        On Error Resume Next
        'Set Temp = .ListObjects(new_nom).Range
        Set Temp = .ListObjects(new_nom)
        On Error GoTo 0
        MsgBox Temp.Range.Address
        If Not Temp Is Nothing Then
            Set rng = Union(Range(new_nom & "[#all]"), Range(new_nom & "[#all]").Offset(-2))
            rng.EntireRow.Delete
        End If

on s'est croisé ;)

joe basé sur ton model

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub jpe_tab1()
    Dim entete, new_nom$, themes, lignes
    entete = Array("toto", "titi", "riri", "fifi", "loulou", "truc", "bidule", "machin", "chose")
    new_nom = "panel1"
    lignes = 6
    themes = "truc bidule" & Date & "/" & "machin"
    create_tableau entete, new_nom, themes, lignes
End Sub
Function create_tableau(entete, new_nom As String, ByVal themes As String, ByVal lignes As Long)
    Dim rng As Range
    With ActiveSheet
        '************************************************************************************
        'ici je voudrais le supprimer si il existe ainsi que tout mise en couleur ou format sur la plage occupée par le tableau
        On Error Resume Next
        'Set Temp = .ListObjects(new_nom).Range
        Set rng = Union(Range(new_nom & "[#all]"), Range(new_nom & "[#all]").Offset(-2))
        On Error GoTo 0
         If Not rng Is Nothing Then msgbox rng.address : rng.EntireRow.Delete
 
        '************************************************************************************
        .Cells(Rows.Count, 1).End(xlUp).Offset(1) = themes
        With .ListObjects.Add(xlSrcRange, .Cells(Rows.Count, 1).End(xlUp).Offset(2).Resize(lignes, UBound(entete) + 1), , xlNo)
            .Name = new_nom
            .TableStyle = "TableStyleMedium11"
            With .HeaderRowRange
                .Value = entete
                .Interior.Color = RGB(0, 100, 0)
                .Font.Color = vbWhite
            End With
        End With
    End With
End Function

18/03/2019, 11h40
RyuAutodidacte

Coucou Patrick :coucou:,

J’ai suivi ton post de loin (trop de taf et donc manque de temps),
J’ai pas très bien compris la démarche/le but de ce code ??
Peux tu m’expliquer ??

Bonjour

Et en remplaçant toutes ces lignes

Code:

1
2
3
4
5
6
7
8
9
10
'************************************************************************************
        'ici je voudrais le supprimer si il existe ainsi que tout mise en couleur ou format sur la plage occupée par le tableau
        For Each TbS In .ListObjects
            Debug.Print TbS.Name & " : "
            If TbS.Name = new_nom Then Set rng = Union(Range(new_nom & "[#all]"), Range(new_nom & "[#all]").Offset(-2))
        Next
        If Not rng Is Nothing Then MsgBox "range a supprimer : " & rng.Address
        If Not rng Is Nothing Then rng.EntireRow.Delete
        '************************************************************************************
  .Cells(Rows.Count, 1).End(xlUp).Offset(1) = themes

par seulement celles-ci ?

Code:

1
2
.Rows("2:10").Delete
.Cells(2, 1) = themes

18/03/2019, 15h37
patricktoulon

re

re
Bonjour ordonc il faut suivre ;)
j'ai precisé au debut qu'il y allait en avoir 8 de tableaux et il ne seront pas toujours au meme endroit
donc les indexs de ligne en dur: pas possible
19/03/2019, 16h03
patricktoulon

Citation:

Envoyé par RyuAutodidacte

Coucou Patrick :coucou:,

J’ai suivi ton post de loin (trop de taf et donc manque de temps),
J’ai pas très bien compris la démarche/le but de ce code ??
Peux tu m’expliquer ??

je telecharge 8 table que je transforme en t structuré
manque de pot elle ne sont pas tout le temps dispos alors elle sont telechargées dans le desordre
et en cours de journée je les telecharge x fois (mise a jour )

d'ou mon besoins de créer le t structuré en le detruisant avant comme ca ils sont pas dans l'ordre sur le sheets mais je n'ai pas de trou blanc (plage orpheline)dans la feuille