Modification d un code VBA (image)

bonjour

j ai une fichier dans le lequel j'affiche une photo

.quand je clique sur une ligne j affiche une photo au dessus du tableau via un chemin qui se trouve dans une colonne H

1iere modif

j aimerai que la photo s 'affiche seulement quand je clique dans la colonne f ou G

2ieme modif

j'aimerai que bien que mon image s'affiche si je deplace mon dossier

dans mon dossier ---- jai le fichier monenclature

---- mon repertoire ou est stocke toute mes images

voici mon fichier

merci de votre aide

Bonjour,

j aimerai que la photo s 'affiche seulement quand je clique dans la colonne f ou G

remplacer la ligne

If Not Intersect(Target, Range("T_nomenclature")) Is Nothing Then

par

adresse = Range("F18:G" & Cells(Rows.Count, 1).End(xlUp).Row).Address
If Not Intersect(Target, Range(adresse)) Is Nothing Then

j'aimerai que bien que mon image s'affiche si je deplace mon dossier 

si le chemin des photo change, il faut aussi changer le chemin écrit en colonne H

ca marche mais j ai perdu ma ligne en surbrillance et ca j y tiens

merci

pour la deuxieme question

j aimerai mettre le chemin dans une cellule et le noms de l'image dans le liens

donc quand je deplace mon fichier j ai juste a changer le chemin dans la cellule

merci de votre aide pour pour ecrire de morceau de code

re,

j ai perdu ma ligne en surbrillance et ca j y tiens

ajouter dans la macro Worksheet_SelectionChange

après la ligne If Not Intersect

Rows(Target.Row).Select

pour la deuxième question

est que le chemin sera le même pour tout les images ? (1 cellule contenant le chemin) ?

ou faut il prévoir une colonne supplémentaire pour mettre les chemins ?

pour ceux qui concerne la premiere question

ca fonctionne pas

voici ou j ai coller la ligne supplémentaire dans le fichier ci joint en dessous

deuxieme

les photos seront toutes dans le meme dossier ( meme endroit ) et le chemin indiquait sera dans la cellule "b15" cellule

et le noms de l'image dans la colonne h (exemple dans le fichier joint )

par contre il faut garder la fonction quand il y a pas de noms de l'image on ouvre la fenetre "explorer pour aller cherche l image "

re,

à tester,

cheminimage = .Range("B15").Value & .Range("h" & selectionligne).Value

voici ce que j ai fais

j 'ai mis le chemin en b15 en le liens de images en H

ca fonctionne mais quand je change ligne ca beugue ala ligne

car j ai supprimer la variable en debut de macro

"cheminimage as string"

merci de ton aide car je seche

re,

essai comme ça,

                With .Pictures
                   .Insert (cheminimage)  
                    With .ShapeRange
                        .LockAspectRatio = msoTrue      'respection des proportion
                        .Height = 200                   'on fixe la hauteur de limage
                        .Name = "selectionimageligne"     'on affecte un non a image
                    End With
               End With

une autre info importante

quand je regarde dans la fenetre variable locale

je vois deux fois le chemin es ce normale ?

re,

as-tu modifier les données de la colonne H (enlever le chemin ne garder que le nom du ficher et son extension) ?

ca marche mais j ai deux j image qui s'affiche

re,

peux-tu joindre ton nouveau fichier ?

le voici

re,

lors de la sélection de la ligne, un 2ème événement Worksheet_SelectionChange était créé.

j'ai ajouté EnableEvents = False pour empêcher ça

à tester,

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        'on empeche de selectionner deux ligne
        If Target.Count > 1 Then Exit Sub
         'on declenche l 'action uniquement dans la plage selectionné
         'morceau a remttre si ligne on veut la ligne complete complete   ''If Not Intersect(Target, Range("T_nomenclature")) Is Nothing Then
        adresse = Range("F18:G" & Cells(Rows.Count, 1).End(xlUp).Row).Address
        If Not Intersect(Target, Range(adresse)) Is Nothing Then

        Application.EnableEvents = False
        Rows(Target.Row).Select
        Application.EnableEvents = True

        'on recupere le numero de la ligne selectionnner
        Range("a1").Value = Target.Row
        'on appelle la procedure affichage image
        Call afficheimage
        Else
        'si non on effeace la cellule de la ligne
        Range("a1").ClearContents
        End If
End Sub

2 problemes

quand il y a pas image ca ouvre explorer et ca met le chemin en entier dans la cellule h

je pense qu'il faudrait ouvrir la fenetre des liens hypertxte pour mettre le non de image comme dans le fichier

toujours deux image qui s'affiche

re,

quand il y a pas image ca ouvre explorer

la solution est appeller la procedure affichage image seulement si le cellule de la colonne H contient une valeur

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'on empeche de selectionner deux ligne
If Target.Count > 1 Then Exit Sub
     'on declenche l 'action uniquement dans la plage selectionné
     'morceau a remttre si ligne on veut la ligne complete complete   ''If Not Intersect(Target, Range("T_nomenclature")) Is Nothing Then
    adresse = Range("F18:G" & Cells(Rows.Count, 1).End(xlUp).Row).Address

    If Not Intersect(Target, Range(adresse)) Is Nothing Then

        Application.EnableEvents = False
         Rows(Target.Row).Select
        Application.EnableEvents = True

        'on recupere le numero de la ligne selectionnner
        Range("a1").Value = Target.Row
        'on appelle la procedure affichage image si le cellule de la colonne H contient une valeur
        If Range("F" & Target.Row) <> "" Then Call afficheimage Else Exit Sub
    Else
        'si non on efface la cellule de la ligne
        Range("a1").ClearContents
    End If
End Sub

toujours deux image qui s'affiche

étant donné qu'il est supposé avoir une seule image sur cette feuille, il faut remplacer cette ligne

.Shapes("selectionimageligne").Delete

par

.Shapes(1).Delete

ca plante dans l insertion image

c'est pas simple

je te mets le fichier modifie

re,

ca plante dans l insertion image

ou, quel ligne du code ?

dans le module affichageimage

la ligne qui est en jaune est

re,

à tester,

Sub afficheimage()
    With Feuil1
        selectionligne = ActiveCell.Row
            If .Range("h" & selectionligne).Value = Empty Then affichageexplorateurfichier
            If .Range("h" & selectionligne).Value = Empty Then GoTo pasimage

            cheminimage = .Range("B15").Value & .Range("h" & selectionligne).Value

            On Error Resume Next
            .Shapes(1).Delete
            On Error GoTo 0

            Set pt = .Pictures  ''.Insert(cheminimage)
            pt.Insert (cheminimage)
                With .Shapes(1)
                    .LockAspectRatio = msoTrue      'respection des proportion
                    .Height = 200                   'on fixe la hauteur de limage
                    .Name = "selectionimageligne"     'on affecte un non a image
                    .Left = Feuil1.Range("g1").Left          '& selectionligne).Left      'a gauche de la colonne
                    .Top = Feuil1.Range("g1").Top             '& selectionligne).Top        'en haut de la colonne
                End With

    End With  'fin de la feuille
pasimage:
End Sub