Microsoft 365 VBA - Insertion image depuis un dossier extérieur, suivant une valeur d'une cellule à partir d'une liste déroulante.

[Arthur EXL]

Bonjour,

Après avoir consulté plusieurs forums et effectué quelques tests avec le peu de connaissances que j'ai en VBA, je me tourne vers vous

Mon Objectif : insérer une image depuis un dossier spécifique, dans une cellule spécifique, en fonction du texte dans une cellule.
Je m'explique : j'ai créer un fichier qui me permet de retrouver un équipement à partir du secteur dans lequel il se trouve (listes en cascade), le tout en VBA.

L'ordre de saisi est le suivant : Secteur > Equipement > Sous-Equipement
De plus, le code vient réécrire en dessous les sélections, ainsi que des informations en plus (pas encore présentes mais se sont les deux colonnes vides).

Je voudrais que si on sélectionne l'équipement "M21 Ventilateur" par exemple, ça me fasse apparaître l'image correspondante, dans une cellule spécifique, et que si par la suite on vient sélectionner une sous-équipement "Armoire Electrique" par exemple, ça remplace l'image du M21 Ventilateur par celle de l'armoire..

J'espère avoir été simple et claire dans mes explications, et que vous pourrez m'aider pour mon projet

Merci par avance de toute pistes ou réponses. Si besoin je peux partager le fichier pour une meilleure compréhension ...

Cordialement,

Arthur

 

[Lolote83]

Re bonjour,
Ca y est, de nouveau accès au site. Du coup, voici un nouveau code qui permet d'insérer une image et de l'agrandir/réduire au contenu H8:I22
Bien sur, le chemin et nom d'image sont à adapter à ton besoin

Sub Cmd_AfficheImage2_Cliquer()
    Application.ScreenUpdating = False
    On Error Resume Next
    xNomGénériqueImage = "MonImage"
    ActiveSheet.Shapes.Range(Array("" & xNomGénériqueImage & "")).Delete
    xRépertoireImage = "C:\Users\toto\Pictures\"             'A adapter
    xFichierImage = "fenetre2.jpg"                               'Nom d'image a afficher
    Nf = xRépertoireImage & "\" & xFichierImage
    If Dir(Nf) <> "" Then
        Set C = Range("H8").MergeArea
        With ActiveSheet
            .Pictures.Insert(xRépertoireImage & xFichierImage).Name = xNomGénériqueImage
            .Shapes(xNomGénériqueImage).Left = C.Left
            .Shapes(xNomGénériqueImage).Top = C.Top
            .Shapes(xNomGénériqueImage).LockAspectRatio = msoFalse
            .Shapes(xNomGénériqueImage).Height = C.Height
            .Shapes(xNomGénériqueImage).Width = C.Width
        End With
    End If
    Application.ScreenUpdating = True
End Sub

@+ Lolote83

 

[Arthur EXL]

Bonjour
Si le cadre contient un OLEObject Image, on devrait pouvoir l'affecter à sa propriété Picture
.Picture = LoadImage(CheminNomFic)
Remarque: pour mettre en CurDir un tel dossier, la séquence ChDrive/ChDir ne marche pas, il faut utiliser l'API SetCurrentDirectoryA

XL 2013 - Ouvrir une fenetre d'ouverture de fichier avec le chemin du classeur courant

Bonjour tout le monde :) je me permets de vous embêter car je ne trouve pas la solution à mon problème malgré mes recherches Je souhaite via vba permettre à l'utilisateur de selectionner un fichier excel qui me permettra de faire plein de trucs avec je souhaiterai que le chemin proposé par...

www.excel-downloads.com

Merci du retour,
En revanche, mes connaissances en VBA sont limités, ce que tu me dis ne me parle pas du tout ... :s

 

[Dranreb]

Dans menu Développeur, groupe Contrôles, commande Insérer, implantez un contrôle Image de la rubrique Contrôles ActiveX et voyez si ce type d'image peut se manipuler plus facilement que les images de formulaire

 

[Arthur EXL]

Re bonjour,
Ca y est, de nouveau accès au site. Du coup, voici un nouveau code qui permet d'insérer une image et de l'agrandir/réduire au contenu H8:I22
Bien sur, le chemin et nom d'image sont à adapter à ton besoin

Sub Cmd_AfficheImage2_Cliquer()
    Application.ScreenUpdating = False
    On Error Resume Next
    xNomGénériqueImage = "MonImage"
    ActiveSheet.Shapes.Range(Array("" & xNomGénériqueImage & "")).Delete
    xRépertoireImage = "C:\Users\toto\Pictures\"             'A adapter
    xFichierImage = "fenetre2.jpg"                               'Nom d'image a afficher
    Nf = xRépertoireImage & "\" & xFichierImage
    If Dir(Nf) <> "" Then
        Set C = Range("H8").MergeArea
        With ActiveSheet
            .Pictures.Insert(xRépertoireImage & xFichierImage).Name = xNomGénériqueImage
            .Shapes(xNomGénériqueImage).Left = C.Left
            .Shapes(xNomGénériqueImage).Top = C.Top
            .Shapes(xNomGénériqueImage).LockAspectRatio = msoFalse
            .Shapes(xNomGénériqueImage).Height = C.Height
            .Shapes(xNomGénériqueImage).Width = C.Width
        End With
    End If
    Application.ScreenUpdating = True
End Sub

@+ Lolote83

Re bonjour,

J'étais en train de répondre à ton dernier poste quand j'ai vu celui-ci
Effectivement ton dernier code fonctionne, et j'ai trouvé le problème. Mon système Windows est en anglais (je travail dans une entreprise internationale) tandis que ce qui est affiché est en français ! Donc les liens doivent être mis en anglais. (Ex : C:\Users\xxx\Pictures et non C:\Users\xxx\Images).
Je vais tester ton nouveau code, en essayant de faire en sorte que les images apparaissent en fonction de ce qui est écrit dans la cellule J5 (suite à la sélection dans les listes) et non l'utilisation d'un bouton.

En attendant, je te remercie pour le coup de pouce !
Je te tiens au courant de mon avancée

 

[Arthur EXL]

Dans menu Développeur, groupe Contrôles, commande Insérer, implantez un contrôle Image de la rubrique Contrôles ActiveX et voyez si ce type d'image peut se manipuler plus facilement que les images de formulaire

D'accord je vois, je vais également essayer cette possibilité, je vous redis

 

[Arthur EXL]

Sub AfficheImage()
    Application.ScreenUpdating = False
    On Error Resume Next
    xNomGénériqueImage = "MonImage"
    ActiveSheet.Shapes.Range(Array("" & xNomGénériqueImage & "")).Delete
    xRépertoireImage = "LIEN"             'A adapter
    image = Range("J5").Value
    xFichierImage = "image.jpg"                               'Nom d'image a afficher
    Nf = xRépertoireImage & "\" & xFichierImage
    If Dir(Nf) <> "" Then
        Set C = Range("H8").MergeArea
        With ActiveSheet
            .Pictures.Insert(xRépertoireImage & xFichierImage).Name = xNomGénériqueImage
            .Shapes(xNomGénériqueImage).Left = C.Left
            .Shapes(xNomGénériqueImage).Top = C.Top
            .Shapes(xNomGénériqueImage).LockAspectRatio = msoFalse
            .Shapes(xNomGénériqueImage).Height = C.Height
            .Shapes(xNomGénériqueImage).Width = C.Width
        End With
    End If
    Application.ScreenUpdating = True
End Sub

J'ai essayé ce code en créant une variable image = Range("J5").Value pour récupérer la valeur en J5, et ainsi utiliser cette variable dans la ligne xFichierImage = "image.jpg".
Est-ce que c'est possible de faire ca ?

 

[Dranreb]

Que ce soit pour une image ActiveX ou de formulaire, essayez plutôt :

xFichierImage = Dir(xRépertoireImage & "\" & Range("J5").Value & ".*")

(xRépertoireImage ayant été renseigné correctement, bien entendu, ou non précisé nulle part mais préalablement mis comme CurDir par un SetCurrentDirectoryA déjà évoqué plus haut)

 

[Arthur EXL]

Que ce soit pour une image ActiveX ou de formulaire, essayez plutôt :

xFichierImage = Dir(xRépertoireImage & "\" & Range("J5").Value & ".*")

(xRépertoireImage ayant été renseigné correctement, bien entendu, ou non précisé nulle part mais préalablement mis comme CurDir par un SetCurrentDirectoryA déjà évoqué plus haut)

Très bien le programme fonctionne !
Maintenant lorsque je sélectionne un sous-équipement, l'image associée apparaît là ou elle doit être.
En revanche, j'ai constaté que s'il n'y a pas d'image, ça met un message d'erreur. Il ne me reste plus que ce détail pour que ma problématique de départ soit résolue... Une idée ?

 

[Dranreb]

ArgDir = xRépertoireImage & "\" & Range("J5").Value & ".*"
xFichierImage = Dir(ArgDir)
If xFicherImage = "" Then MsgBox "Il n'existe pas de fichier """ & ArgDir & """.", _
   vbCritical, LeNomDeLaProcédure): Exit Sub

 

[Arthur EXL]

ArgDir = xRépertoireImage & "\" & Range("J5").Value & ".*"
xFichierImage = Dir(ArgDir)
If xFicherImage = "" Then MsgBox "Il n'existe pas de fichier """ & ArgDir & """.", _
   vbCritical, LeNomDeLaProcédure): Exit Sub

Bonsoir,
Désolé pour la réponse très tardive, j'ai eu quelques problèmes perso...
Je voulais clôturer ce sujet car votre aide m'a permis d'atteindre mes objectifs...
Peut être que j'ouvrirai d'autres sujets si je suis bloqué sur une fonctionnalité que je souhaite ajouter à mon fichier.

Merci à @Dranreb et @Lolote83 pour votre temps et solutions

 

[Pronzito]

Bonsoir à tous
J'ai besoin de votre aide. Je souhaite insérer des photos à l'aide d'un code VBA (j'avoue que je n'y connais pas trop). Une photo par page (100 pages )en fonction du nom qui s'affiche dans une cellule. J'aimerais également que les photos changent dès que le nom change. Merci