suprimer un listobject du sheets avant de le reconstruire

**patricktoulon** · 18/03/2019, 08h58

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 ?

**boisgontierjacques** · 18/03/2019, 09h08

Bonjour,

D'après l'aide

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Boisgontier

**patricktoulon** · 18/03/2019, 09h17

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

**boisgontierjacques** · 18/03/2019, 09h29

Supprime complétement le tableau

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**patricktoulon** · 18/03/2019, 09h50

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**boisgontierjacques** · 18/03/2019, 10h01

Je suppose que tu connais

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**joe.levrai** · 18/03/2019, 10h07

Bonjour,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**patricktoulon** · 18/03/2019, 10h18

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**patricktoulon** · 18/03/2019, 10h30

@Joe

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
Nom : demo3.gif
Affichages : 860
Taille : 699,9 Ko

Nom : demo3.gif
Affichages : 860
Taille : 699,9 Ko

**joe.levrai** · 18/03/2019, 10h33

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 ?

**patricktoulon** · 18/03/2019, 10h52

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**patricktoulon** · 18/03/2019, 11h00

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 .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

**patricktoulon** · 18/03/2019, 11h06

bon ca y est ca match maintenant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**joe.levrai** · 18/03/2019, 11h08

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim Temp As Range

si on le laisse en Listobject, il faut faire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set Temp = .ListObjects(new_nom)

et ensuite

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**patricktoulon** · 18/03/2019, 11h15

j'ai trouvé ton erreur joe

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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é

**patricktoulon** · 18/03/2019, 11h23

joe basé sur ton model

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**RyuAutodidacte** · 18/03/2019, 11h40

Coucou Patrick

,

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 ??

**OrDonc** · 18/03/2019, 11h53

Bonjour

Et en remplaçant toutes ces lignes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**patricktoulon** · 18/03/2019, 15h37

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

**patricktoulon** · 19/03/2019, 16h03

Envoyé par RyuAutodidacte

Coucou Patrick

,

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

suprimer un listobject du sheets avant de le reconstruire

Macros et VBA Excel

Discussions similaires

Partager

Partager