Inserer plusieurs photos dans des cellules différentes VBA sans bouton

[Irina1009]

Bonjour,

Je viens vers vous car je suis débutante en VBA et je suis confrontée à quelque chose bien au dessus de mes compétences en la matière...

Je vous explique mon besoin :

Dans le classeur Excel joint se trouve dans un 1er onglet un tableau.
Je le complète au fur et à mesure et celui-ci "alimente" le 2eme onglet en remplissant automatiquement les champs.
Dans l'onglet "modèle" en cliquant dans la cellule A14 je peux aller chercher le numéro d'hydrant voulu et les informations changent en fonction de la ligne du tableau du premier onglet auxquelles elles font référence.

Mais le formulaire créé dans le deuxième onglet n'est pas complet. Il manque 3 photos , qui doivent donc s'afficher automatiquement en fonction du numéro d'hydrant choisi en A14.

Je suis novice dans ce domaine je suis parvenue à trouver des solutions afin de créer mon tableau et pour une seule photo mais 3 cela devient difficile.
Il faut que les photos s'affichent et disparaissent automatiquement en fonction du numéro de l'hydrant.
J'ai 600 feuilles modèle à créer et éditer.

Merci d'avance pour votre précieuse aide et vos explications.

J'ai impérativement besoin de cette solution qui serait un soulagement.

 

[job75]

Bonjour Irina1009, bienvenue sur XLD,

Le plus simple est de superposer à l'emplacement de chaque photo autant d'images qu'il y a d'éléments dans la liste en A14 (3 dans l'exemple).

Les images seront nommées Image_1_1 Image_1_2 Image_1_3 Image_2_1 etc...

Ensuite une macro Workbook_SheetChange affichera/masquera les images en fonction de l'élément choisi en A14.

Joignez un fichier avec les 9 photos installées, je créerai ensuite la macro.

A+

 

[Irina1009]

Bonjour Irina1009, bienvenue sur XLD,

Le plus simple est de superposer à l'emplacement de chaque photo autant d'images qu'il y a d'éléments dans la liste en A14 (3 dans l'exemple).

Les images seront nommées Image_1_1 Image_1_2 Image_1_3 Image_2_1 etc...

Ensuite une macro Workbook_SheetChange affichera/masquera les images en fonction de l'élément choisi en A14.

Joignez un fichier avec les 9 photos installées, je créerai ensuite la macro.

A+

Voici les photos

 

[Irina1009]

Voici

 

[job75]

Re,

Merci pour les photos, je les ai transférées une par une dans le fichier Excel avec votre macro.

La macro dans ThisWorkbook est très simple :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim p As Picture
If Sh.Name <> "Tableau" And Target.Address = "$A$14" Then
    For Each p In Sh.Pictures
        p.Visible = p.Name Like "*" & Target
    Next
End If
End Sub

Elle se déclenche quand on modifie la cellule A14.

Fichiers joints à placer dans le même répertoire (le bureau).

A+

 

[Irina1009]

Merci cela fonction à merveille.
Par contre où modifier le chemin des photos comme dans mon exemple.
C:\Users\Documents\Photos\DossierNumeroPhoto
dans le code VBA car mes photos se trouvent dans un répertoire et pour chaque test hydrant j'ai 3 photos dans un dossier u nom de l'hydrant(ex 10044)




Sub ImportImg()
Dim nomimage$, Image As Picture
nomimage = ThisWorkbook.Path & "\10044_3.jpg" '<-- changez pour votre répertoire
Set Image = ActiveSheet.Pictures.Insert(nomimage)
With Image
.ShapeRange.LockAspectRatio = msoFalse
.Left = ActiveCell.Left
.Top = ActiveCell.Top
.Height = ActiveCell.MergeArea.Height
.Width = ActiveCell.MergeArea.Width
.Name = "3_10044"
End With
End Sub

 

[job75]

Re,

Comme je l'ai dit mettez les 9 photos et le fichier Excel dans le même répertoire.

Et transférez-les une par une dans la cellule idoine en adaptant bien sûr la macro.

A+

 

[Irina1009]

merci infiniment.

 

[Irina1009]

J'ai complété mon tableau avec d'autres résultats. J'ai également inséré mes photos dans le dossier où se situe mon fichier excel.
les photos correspondant au numéro d'hydrant demandé en A14 de la feuille "Rapport" n’apparaissent pas.
Pouvez-vous m'indiquer comment changer le code afin de pouvoir inserer le lien du répertoire ?

Merci d'avance.

 

[job75]

Bonjour Irina1009,

Il faut placer les images au bon endroit.

Sur PHOTO 1 il faut placer "1_10044" "1_10046" "1_10047".

Or vous y avez mis "3_10044" "3_10044" "1_10046".

Sur PHOTO 2 et PHOTO 3 il y a une seule image...

Vous avez parlé de 600 feuilles, vous n'êtes pas au bout de vos peines...

A+

 

[Irina1009]

Oui c'est ce que je me dis...
Je désespère je voudrais trouver une solution qui soit plus facile mais je ne suis pas assez compétente en vba...
Merci de votre aide

 

[job75]

Re,

Je désespère je voudrais trouver une solution qui soit plus facile

Faut pas désespérer il y a toujours une solution, créez les images avec cette macro :

Sub ImportImg()
Dim a, w As Worksheet, c As Range, x$, i As Byte, nomimage$, cible As Range, Image As Picture
a = Array("C6", "L11", "L21") 'adresses des cellules des photos
For Each w In Worksheets
    If w.Name <> "Tableau" Then
        w.Pictures.Delete 'RAZ
        For Each c In [ID] 'nom défini ID pour la liste de validation
            If c <> "" Then
                x = ThisWorkbook.Path & "\" & c
                For i = 1 To 3
                    nomimage = x & "_" & i & ".jpg"
                    If Dir(nomimage) <> "" Then
                        Set cible = w.Range(a(i - 1))
                        Set Image = w.Pictures.Insert(nomimage)
                        With Image
                            .ShapeRange.LockAspectRatio = msoFalse
                            .Left = cible.Left
                            .Top = cible.Top
                            .Height = cible.MergeArea.Height
                            .Width = cible.MergeArea.Width
                            .Name = i & "_" & c
                        End With
                    End If
                Next i
            End If
        Next c
    End If
    w.[A14] = w.[A14] 'lance la macro Workbook_SheetChange
Next w
End Sub

Il faut comme sur le fichier joint que la liste de validation en A14 soit définie par le nom ID.

Et comme déjà dit les fichiers JPG et le fichier Excel doivent être dans le même répertoire.

A+

 

[Irina1009]

Cette macro marche parfaitement !
C'est réellement un énorme soulagement et va me faire gagner un temps très précieux !
600 lignes contenant pour chacune 3 photos...
et des tableaux comme celui-ci j'en ai environs 60...

Imaginez-donc...

Il faut absolument que je devienne plus autonome en VBA et trouver des liens internet pour pouvoir me former seule.

Merci infiniment pour votre aide.

 

[Irina1009]

Bonjour,

Je viens à nouveau demander de l'aide car je rencontre un soucis au niveau de mon tableau.
Je dois intégrer 2 logos en haut à gauche et à droite de la partie rapport (second onglet) cependant lorsque je sélectionne un nouveau numéro d'hydrant en A14 mes logos disparaissent ???!!!??
Mon tableau est situé dans le même répertoire que les photos ainsi que les logo en format jpg.

une solution ??

 

[job75]

Bonsoir Irina1009,

Nommez les images de vos logos LOGO 1 et LOGO 2 puis :

1) dans la macro ImportImg remplacez w.Pictures.Delete 'RAZ par :

        For Each Image In w.Pictures
            If Not UCase(Image.Name) Like "LOGO*" Then Image.Delete
        Next Image

2) complétez la macro Workbook_SheetChange :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim p As Picture
If Sh.Name <> "Tableau" And Target.Address = "$A$14" Then
    For Each p In Sh.Pictures
        p.Visible = p.Name Like "*" & Target Or UCase(p.Name) Like "LOGO*"
    Next
End If
End Sub

Bonne nuit.