XL 2016 Images dans tableau structuré

fanch55 · 29 Octobre 2020

Bonjour à tous,
Je rencontre une bizarrerie dans Excel : J'ai un tableau structuré (Tableau1) .
Une des colonnes contient des images ( une par ligne ) .
Quand je veux vider ce tableau, toutes les lignes sont "vidées" : contenu des cellules etc..
mais il me reste imperturbablement toujours l'image de la première ligne même si la ligne de tableau n'existe plus ( par code ou manuellement ....)

C'est un peu ch... surtout que je ne comprend pas pourquoi ...

Auriez-vous une astuce ou une raison à celà ?

Pour charger les lignes du tableau et des image, cliquer sur "Load"
Pour effacer les lignes, cliquez sur "Clear" ou sélectionnez les lignes et clic-droit: supprimer les lignes du tableau

Dudu2 · 29 Octobre 2020

Supprime toutes les Shapes d'abord...

VB:

Sub Efface()
    Dim Sh As Shape
    Dim Cell As Range
   
    With [tableau1].ListObject
        If Not .DataBodyRange Is Nothing Then
            For Each Cell In .ListColumns("Image").DataBodyRange.Cells
                For Each Sh In [tableau1].Parent.Shapes
                    If Sh.Top = Cell.Top + 4 Then
                        Sh.Delete
                        Exit For
                    End If
                Next Sh
            Next Cell
       
            .DataBodyRange.Delete
        End If
    End With
End Sub

Dudu2 · 29 Octobre 2020

Bonjour,
Ah, la 1ère ligne des tableaux structurés qui est là sans être là quand le DataBodyRange is Nothing !
Un vrai cauchemar. J'ai passé des heures et des heures juste pour faire une fonction de Resize du DataBodyRange en gérant les comportements improbables d'Excel (avec ou sans Header Row ou Totals Row) sur les tableaux structurés.

En fait tu ne peux pas te débarrasser de l'image comme ça, il faut la supprimer spécifiquement.

VB:

Sub Efface()
    Dim Sh As Shape
   
    With [tableau1].Parent.ListObjects("tableau1")
        If Not .DataBodyRange Is Nothing Then
            For Each Sh In [tableau1].Parent.Shapes
                If Sh.Top = .ListColumns("Image").DataBodyRange.Cells(1).Top + 4 Then
                    Sh.Delete
                    Exit For
                End If
            Next Sh
       
            .DataBodyRange.Delete
        End If
    End With
   
   
    'If Not [tableau1].ListObject.DataBodyRange Is Nothing Then [Tableau1[#Data]].Delete
End Sub

fanch55 · 29 Octobre 2020

Salut @Dudu2

Dudu2 à dit:
En fait tu ne peux pas te débarrasser de l'image comme ça, il faut la supprimer spécifiquement.

Ah ça, je voulais l'éviter.
D'après le code, il faut détruire les shapes avant les rows, c'est pas fun ... ( les shapes concernent-ils le tableau ? ), ça va être lourd : tester les intersect , grrrrr ...

Dudu2 · 29 Octobre 2020

Dans le code ci-dessus on ne .Delete que la Shape de la 1ère ligne, pas toutes.
Les Shapes ne sont pas vues comme contenu du tableau, donc tu n'y coupes pas de les traiter séparément, sauf que dans la suppression effectives des lignes 2 à N, elles disparaissent parce qu'incluses dans les lignes du tableau supprimées. Alors que la ligne 1 n'est pas physiquement supprimée.

D'ailleurs il serait plus logique de les supprimer toutes avant de supprimer les lignes du tableau.

Dudu2 · 29 Octobre 2020

Supprime toutes les Shapes d'abord...

VB:

Sub Efface()
    Dim Sh As Shape
    Dim Cell As Range
   
    With [tableau1].ListObject
        If Not .DataBodyRange Is Nothing Then
            For Each Cell In .ListColumns("Image").DataBodyRange.Cells
                For Each Sh In [tableau1].Parent.Shapes
                    If Sh.Top = Cell.Top + 4 Then
                        Sh.Delete
                        Exit For
                    End If
                Next Sh
            Next Cell
       
            .DataBodyRange.Delete
        End If
    End With
End Sub

fanch55 · 29 Octobre 2020

Bon, j'ai peut-être un code par dépit qui fonctionne :
Attention l'ordre est important l'image.delete avant le tableau.delete

VB:

Sub Efface()
    For Each Image In ActiveSheet.Pictures
        If Not Intersect(Image.TopLeftCell, [Tableau1[Image]]) Is Nothing Then Image.Delete
    Next
    If Not [Tableau1].ListObject.DataBodyRange Is Nothing Then [Tableau1[#Data]].Delete
End Sub

Merci @Dudu2, tu m'as mis sur la voie ...

fanch55 · 29 Octobre 2020

Oki, si personne n'a d'objection ou d'autre proposition, je vais marquer le post #6 comme solution .
Mais on ne m'enlèvera pas le sentiment qu'il y a un bug qq part ..

fanch55 · 29 Octobre 2020

Whaaalouhhh, je ne peux pas marquer un de mes post comme solution !!!
@Dudu2, je marque ton dernier post comme solution, c'est pas la peine que qq d'autre se casse les méninges pour rien ..

laurent950 · 29 Octobre 2020

Bonsoir

How to delete all pictures in a range of cells?

ExtendOffice provides a comprehensive range of professional software solutions, enhancing productivity and efficiency for businesses worldwide.

www.extendoffice.com

VB:

Sub Efface()
' 1) #Data
    If Not [Tableau1].ListObject.DataBodyRange Is Nothing Then [Tableau1[#Data]].Delete
' 2) Picture
    Dim xPicRg As Range
    Dim xPic As Picture
    Dim xRg As Range
    Application.ScreenUpdating = False
    Set xRg = Range("Tableau1")
    For Each xPic In ActiveSheet.Pictures
        Set xPicRg = Range(xPic.TopLeftCell.Address & ":" & xPic.BottomRightCell.Address)
        If Not Intersect(xRg, xPicRg) Is Nothing Then xPic.Delete
    Next
    Application.ScreenUpdating = True
End Sub

fanch55 · 29 Octobre 2020

@laurent950
Salut laurent, merci
mais j'ai remarqué que si tu deletes le tableau avant les images, ces derniers ne sont plus dans le scope du tableau, normal ...

Dudu2 · 29 Octobre 2020

@fanch55,
Ta façon de faire est bien efficace. Un petit détail:
For Each Image In ActiveSheet.Pictures
Plutôt (par sécurité, on ne sait jamais)
For Each Image In [Tableau1].Parent.Pictures
Effectivement on ne peut soi-même se résoudre un problème

laurent950 · 29 Octobre 2020

Ca fonctionne dans les deux sens :

How to delete all pictures in a range of cells?

ExtendOffice provides a comprehensive range of professional software solutions, enhancing productivity and efficiency for businesses worldwide.

www.extendoffice.com

Excel: Les tableaux structurés en VBA

fauconnier.developpez.com

A ) deletes les images avant le tableau...

VB:

Sub EffaceBis()
    Dim xPicRg As Range
    Dim xPic As Picture
    Dim xRg As Range
    Application.ScreenUpdating = False
    Set xRg = Range("Tableau1")
' 1) Picture (Supression des images dans le tableau structuré)
    For Each xPic In ActiveSheet.Pictures
        Set xPicRg = Range(xPic.TopLeftCell.Address & ":" & xPic.BottomRightCell.Address)
        If Not Intersect(xRg, xPicRg) Is Nothing Then xPic.Delete
    Next
' 2) Data (Suppression des datas dans le tableau structuré)
    xRg.Delete
    Application.ScreenUpdating = True
End Sub

B ) deletes le tableau avant les images...

VB:

Sub EffaceTer()
    Dim xPicRg As Range
    Dim xPic As Picture
    Dim xRg As Range
    Application.ScreenUpdating = False
    Set xRg = Range("Tableau1")
' 2) Data (Suppression des datas dans le tableau structuré)
    xRg.Delete
' 1) Picture (Supression des images dans le tableau structuré)
    For Each xPic In ActiveSheet.Pictures
        Set xPicRg = Range(xPic.TopLeftCell.Address & ":" & xPic.BottomRightCell.Address)
        If Not Intersect(xRg, xPicRg) Is Nothing Then xPic.Delete
    Next
    Application.ScreenUpdating = True
End Sub

fanch55 · 29 Octobre 2020

@laurent950
Effectivement, test de tous tes codes ok ...
J'ai même interverti mon code, cela fonctionne aussi
Je ne sais pas pourquoi il ne m'a pas détecté l'intersect une fois (coz deboggage en cours peut-être) d'où la conclusion un peu hâtive ..

Dudu2 à dit:
For Each Image In [Tableau1].Parent.Pictures

Effectivement, plus rigoureux donc plus précis

XL 2016 Images dans tableau structuré

fanch55

XLDnaute Barbatruc

Pièces jointes

Dudu2

Dudu2

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

How to delete all pictures in a range of cells?

fanch55

XLDnaute Barbatruc

Dudu2

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

How to delete all pictures in a range of cells?

Excel: Les tableaux structurés en VBA

fanch55

XLDnaute Barbatruc

Discussions similaires