Microsoft 365 Liste déroulante image

[dubarre]

Bonjour à tous,

Je viens vers vous car je n'arrive pas à trouver la solution concernant une liste déroulante.

J'ai un tableau avec toutes les photos que je veux répertorié avec le nom prénom dimension et autres, dans le fichier exemple que je vous ai envoyé il y a 2 colonne une avec la photo et une avec le nom mais cela pourra me donner un ordre d'idée pour le fichier que je crée.

je voudrais dans la feuill2 dans la liste déroulante voir les photos qui sont en colonne A de la feuil1. Les photos que je vais pouvoir mettre en exposition

Pouvez-vous m'aider s'il vous plaît à trouver la solution soit par un tutoriel soit par un exemple sur le fichier que je vous transmets en vous remerciant d'avance.

 

[James007]

Bonjour,

Dans la mesure où cette question est assez fréquente .. as-tu jeté un oeil au bas de cette page ... aux 10 Sujets identiques au tien ...

 

[BOISGONTIER]

Bonjour,


Exemple:http://boisgontierjacques.free.fr/fichiers/DonneesValidation/DVMeteo.xls


Boisgontier

 

[dubarre]

Bonjour à tous,

Je vous remercie pour l'attention que vous portez pour pouvoir m'aider mais ce que vous répondez ne correspond pas à ce que j'ai besoin.

N'est-il vraiment pas possible d'afficher les images dans la liste déroulante directement car c'est sur les images que je vais choisir les tableaux pour l'exposition et non par le nom et sinon est-il possible de le faire à partir d'un UserForm.

En vous remerciant d'avance de votre aide

 

[patricktoulon]

re
bonjour
je pense pas que ca existe
voir avec un treeview ou une listview avec icon si compatible avec 365
sinon il te faudra la construire de toute pièce dans une frame avec scroll vertical

 

[job75]

Bonjour dubarre, James007, JB, patricktoulon,

Voyez le fichier joint et ces 2 macros dans le code de Feuil2 :

Private Sub Worksheet_Activate()
With Feuil1.ListObjects(1).Range
    .Sort .Columns(2), xlAscending, Header:=xlYes 'tri
    With .Cells(1).CurrentRegion
        If .Rows.Count > 1 Then .Columns(2).Offset(1).Resize(.Rows.Count - 1).Name = "Liste" Else ThisWorkbook.Names.Add "Liste", "=#N/A"
    End With
End With
With ListObjects(1).Range
    With .Cells(2, 1).Resize(.Rows.Count - 1).Validation
        .Delete
        If Not IsError([Liste]) Then .Add xlValidateList, Formula1:="=Liste"
    End With
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim z, i&, j As Variant
Application.ScreenUpdating = False
Application.CutCopyMode = 0
z = ActiveWindow.Zoom 'mémorise
ActiveWindow.Zoom = 100 'c'est nécessaire
On Error Resume Next 'si l'image ne se crée pas
DrawingObjects.Delete 'RAZ
With ListObjects(1).Range
    For i = 2 To .Rows.Count
        j = Application.Match(.Cells(i, 1), Feuil1.Columns(2), 0)
        If IsNumeric(j) Then
            With .Cells(i, 2)
                .CopyPicture
                While TypeName(Selection) = "Range": Paste: DoEvents: Wend 'en attente du collage
                Selection.Top = .Top
                Selection.Left = .Left
                Selection.Formula = "=" & Feuil1.Cells(j, 1).Address(External:=True)
            End With
            Application.CutCopyMode = 0
            ActiveCell.Activate
        End If
    Next
End With
ActiveWindow.Zoom = z 'état initial
End Sub

La 1ère macro crée les listes de validation, la 2ème macro crée les images choisies.

A+

 

[job75]

La macro Worksheet_Change précédente prend trop de temps s'il y a trop d'images en Feuil2, utilisez ce fichier (2) :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim F As Worksheet, z, i As Variant, o As Object
Set F = Feuil1 'CodeName de la feuille source, à adapter
With ListObjects(1).Range
    Set Target = Intersect(Target, .Columns(1).Offset(1).Resize(.Rows.Count - 1))
End With
If Target Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.CutCopyMode = 0
z = ActiveWindow.Zoom 'mémorise
ActiveWindow.Zoom = 100 'c'est nécessaire
On Error Resume Next 'si l'image ne se crée pas
For Each Target In Target 'si entrées/effacements multiples
    With Target(1, 2)
        For Each o In DrawingObjects
            If o.TopLeftCell.Address = .Address Then o.Delete 'RAZ
        Next o
        i = Application.Match(Target, F.Columns(2), 0)
        If IsNumeric(i) Then
            .CopyPicture
            While TypeName(Selection) = "Range": Paste: DoEvents: Wend 'en attente du collage
            Selection.Top = .Top
            Selection.Left = .Left
            Selection.Formula = "=" & F.Cells(i, 1).Address(External:=True)
            Application.CutCopyMode = 0
            ActiveCell.Activate
        End If
    End With
Next Target
ActiveWindow.Zoom = z 'état initial
End Sub

Pour tester j'ai entré le mot "Femme" dans la plage A2:A100 => la macro s'exécute chez moi en 193 secondes (99 images créées).

Mais ensuite si l'on modifie une seule cellule la macro s'exécute en 4 secondes.

 

[herve62]

Bonsoir
J'ai retrouvé une appli complète de ce genre que j'avais commencé à utiliser , un squelette que j'ai remodelé à ma sauce en y ajoutant principalement
l'ajustement auto des hauteurs de lignes selon photo
Déjà , est ce que ce genre pourrait t'aller ?
Sinon j'ai encore une autre appli ( toujours idem ) que j'avais fait pour un membre dans laquelle j'avais repris le principe mais il pouvait choisir ses images via l'explorateur donc pas besoin comme ici de les stocker dans le même rep. ; On pourrait re greffer la partie du code pour le choix dans l'USF
Là le principe : avoir toutes les images de base dans le rep. du fichier excel, le nom en E doit être le nom de l'image
Cliquer cellule dont les col. sont hors zone tableau > USF
A tester

 

[dubarre]

Bonsoir Hervé, Oui dans l'idée cela correspond à ce que j'ai besoin il faudrait que la liste déroulante qui affiche les images soit dans la colonne image dans la feuille transfert car je dois vraiment partir de l'image et non du nom. En vous remerciant à tous pour votre aide

 

[job75]

Re, salut herve62,

dubarre ignore les autres intervenants mais peu importe

car je dois vraiment partir de l'image et non du nom.

D'accord, alors pas besoin de liste de validation, utilisez le double-clic dans les 2 feuilles de ce fichier (3).

En Feuil1 pour créer l'image en Feuil2 :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set Target = Intersect(Target, ListObjects(1).Range.Columns(2).Offset(1))
If Target Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
Dim c As Range, z
Cancel = True
With Feuil2 'CodeName, à adapter
    Set c = .Cells(Application.Match("zzz", .Columns(2)) + 1, 1) '1ère cellule vide
    c(1, 2) = Target.Value
    Application.ScreenUpdating = False
    Application.CutCopyMode = 0
    On Error Resume Next 'si l'image ne se crée pas
    .Activate
    ActiveCell.Activate 'si la sélection n'est pas un Range
    z = ActiveWindow.Zoom 'mémorise
    ActiveWindow.Zoom = 100 'c'est nécessaire
    c.CopyPicture
    While TypeName(Selection) = "Range": .Paste: DoEvents: Wend 'en attente du collage
    Selection.Top = c.Top
    Selection.Left = c.Left
    Selection.Formula = "=" & Target(1, 0).Address(External:=True)
    Application.CutCopyMode = 0
    ActiveCell.Activate
    ActiveWindow.Zoom = z
End With
Me.Activate 'retour
End Sub

En Feuil2 pour effacer tout le tableau :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If MsgBox("Effacer tout le tableau ?", 4, "Effacer") = 7 Then Exit Sub
Cancel = True
DrawingObjects.Delete
With ListObjects(1)
    .Range.Offset(1).ClearContents
    .Resize .Range.Resize(2)
End With
End Sub

A+

 

[dubarre]

Bonsoir job, avec tout le respect que je dois à toutes les personnes si tu lis bien mon dernier message à la fin je vous remercie tous.

 

[dubarre]

Bonsoir job, cela correspond correctement à ce que j'ai besoin il faudra juste que je mette un bouton pour le côté effacer le tableau dans la feuille deux car si par erreur je clique il est vrai que y a la validation mais un bouton sera quand même plus pratique.

Et je tiens vraiment à remercier tout le monde pour l'attention que vous avez porté à mon petit problème pour moi il est résolu.

Cordialement

 

[job75]

Pour la Feuil2 il vaut mieux le double-clic puisque l'on supprime tous les objets.

On peut mettre un bouton mais alors il faut une boucle pour éviter sa suppression.

 

[dubarre]

OK d'accord je vais essayer de faire ça tout seul car c'est en faisant qu'on apprend et si je n'y arrive pas si vous m'autorisez je viendrai vers vous. Cordialement

 

[job75]

En effet c'est un bon exercice, allez-y, je vous aiderai au besoin.