XL 2016 AIDE tri automatique avec images

Maathis · 29 Octobre 2020

Bonjour à tous,

Je revient vers vous pour un problème avec une macro de tri automatique de ma base de données suivant un critère.
Je vais essayer d'être précis dans mes explications

Donc j'ai une base de données avec des images pour chaque donnée et sur une autre feuille, la gestion de telle sorte que les utilisateurs peuvent choisir leur critère et toutes les données comportant ce critère s'affichent.
J'utilise donc l'outil filtre avancé que j'ai pu enregistrer qui me donne:

VB:

  Application.CutCopyMode = False
    
    Sheets("Base").Range("Tableau1[#All]").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("O7:O8"), CopyToRange:=Range("B11:G11"), Unique:= _
        False
        
    Range("E8").Select

Ce code marche bien pour les valeurs autres que les images mais mon souci est que j'aimerais bien qu'avec les données qui soient triées, leurs images correspondantes s'affichent aussi. Or j'ai bien sélectionné dans ma plage pour filtrer la colonne avec les images mais aucune n'image apparaît.

Si c'est possible, il faudrait que les images s'affichent aussi quand la macro copie la ligne et point supplémentaires que la ligne copiée garde la même hauteur, pour que l'image garde ses proportions.

Merci d'avance pour votre aide

Maathis · 30 Octobre 2020

Personne n'aurait la solution ?

Merci

patricktoulon · 30 Octobre 2020

re
bonjour
a tu déjà entendu parler de CopyObjectsWithCells

non!? ben il est temps de faire une recherche

Maathis · 30 Octobre 2020

Merci j'ai pu chercher et je l'ai rajouté à mon code mais cela ne fonctionne toujours pas

VB:

    Application.CutCopyMode = False
    Application.CopyObjectsWithCells = True
    
    Sheets("Base").Range("Tableau1[#All]").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("O7:O8"), CopyToRange:=Range("B11:G11"), Unique:=True
        
    Range("E8").Select

Merci

patricktoulon · 30 Octobre 2020

poster avec la demande un fichier exemple diminué a l’essentiel du problème et sans données confidentielles serait le bien venu

Maathis · 30 Octobre 2020

Alors du coup j'ai créer un fichier de test et à ma grande surprise, les images s'inséraient aussi avec le texte au moment du filtrage des données.
Mais quand on change le sexe "homme" ou "femme" et qu'on effectue à nouveau un tri, les anciennes image restent en dessous des nouvelles.

Ce que j'aimerais bien c'est que dans mon fichier perso les images s'insèrent aussi mais qu'elle disparaissent quand on effectue à nouveau le tri pour d'autres données.

Je vous met ci-joint un fichier test avec aucune données confidentielles.

Merci à vous

patricktoulon · 30 Octobre 2020

re

VB:

Sub FiltreData()
    For Each shap In Sheets("Gestion").Shapes
        If shap.Name <> "bouton" Then shap.Delete
    Next
    With [B4:E1000]: .ClearContents: .Interior.Color = xlNone: End With
    
    Application.CopyObjectsWithCells = True
    With Sheets("BD").ListObjects("Tableau1").Range
        .AutoFilter Field:=3, Criteria1:=[I2].Text
        .SpecialCells(xlVisible).Copy Destination:=[B4]
        .AutoFilter
    End With
End Sub

tape homme ou femme en I1 et lance la sub

problème
en supprimant les shapes ca supprime la liste de validation
sinon c'est bon

patricktoulon · 30 Octobre 2020

RE
tiens j'en ai eu marre de perdre la liste de validation a chaque fois
je crée un popup menu dynamique
clique sur le bouton sexe

Maathis · 3 Décembre 2020

Merci pour ton aide, ton fichier fonctionne parfaitement comme j'aimerais que le mien fonctionne mais malheureusement je n'arrive pas a faire fonctionner le code, je pense qu'il doit y avoir un problème avec mes images. Je pense que je vais abandonner et garder la solution simple du filtre automatique pour les tableaux excel

Merci beaucoup quand même pour votre aide.

patricktoulon · 3 Décembre 2020

Bonjour
a bon ?
tu a une erreur c'est quoi le message ?

Maathis · 3 Décembre 2020

Bonjour,
Heureusement j'ai tout recommencé depuis le début et victoire ça marche parfaitement
J'ai repris ton code et j'ai adapté pour mes valeurs.
Milles merci pour ton aide, tu m'enlève une épine du pied.

Mais il reste un détail que j'aimerais enlever pour être perfectionniste.
En effet dans le filtrage automatique, la taille de mes valeurs change. Mais le tableau garde tous le temps la même taille donc j'ai une barre noir de fin de tableau qui me gêne.
Comment je pourrais faire pour assigner ma sélection à la nouvelle taille du tableau ?
Mon (ton) code :

Code:

    metier = CommandBars.ActionControl.Caption
    For Each shap In Sheets("Gestion").Shapes
        If shap.name <> "BTFiltre" And shap.name <> "BTRetour" And shap.name <> "BTSupp" Then
            shap.Delete
        End If
        
    Next
    Range("B6:G1000").Select
    With Selection
        .ClearContents
        .Interior.Color = xlNone
    End With
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    
    
    Application.CopyObjectsWithCells = True
    With Sheets("Base").ListObjects("Tableau1").Range
        .AutoFilter Field:=5, Criteria1:=metier
        .SpecialCells(xlVisible).Copy Destination:=[B5]
        .AutoFilter
    End With
    
    lastcell = Range("F10000").End(xlUp).Row
    Set Tableau13 = Range("B6:I" & lastcell)

J'ai essayé avec ça mais ça ne fonctionne pas

Code:

lastcell = Range("F10000").End(xlUp).Row
    Set Tableau13 = Range("B6:I" & lastcell)

patricktoulon · 3 Décembre 2020

re
donne moi le fichier je suis pas magicien

Maathis · 3 Décembre 2020

Il y a trop de données confidentielles, j'ai modifié le code dans mon fichier directement et non dans celui que j'avais transmis sur le forum.
Merci

patricktoulon · 3 Décembre 2020

ma fois sans fichier je ne peut pas voir ce qui se passe

XL 2016 AIDE tri automatique avec images

Maathis

XLDnaute Nouveau

Maathis

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

Maathis

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

Maathis

XLDnaute Nouveau

Pièces jointes

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Pièces jointes

Maathis

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

Maathis

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

Maathis

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

Discussions similaires