Discussion :

[patricktoulon]

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]

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]

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]

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]

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]

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]

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