Discussion :

[graphikris]

Bonjour,
J'ai créé une base de données allant de A1 jusqu'à IV sur 150 lignes (feuil1).

Ensuite j'ai une autre feuille (feuil2), dans laquelle je sélectionne dans une liste déroulante le nom de la personne recherchée et grace à la fonction " Recherche V", les renseignements (date de naissance, dates des stages,etc...) viennent se mettre dans les cellules programmées.

J'aimerais intégrer dans cette feuil2 à un emplacement déterminé (ex : entre F2 et G4, la photo d'identité (qui se trouve sur le disque c:\ dans un répertoire nommé "identités" de la personne recherchée.

Attention, il y a environ 120 photos et le nombre risque de varier en + ou en - au moment des départs ou arrivées dans l'entreprise.

Cette feuil2 est également imprimable en A3 et il faut que la photo s'imprime également.

Joyeux noël

[vieuxmonsieur]

Bonjour,
Sans être un expert Excel, voici une petit macro qui va insérer la photo de ton choix dans la cellule F2.
La photo sera redimensionnée à la taille de la cellule.
A toi d'adapter.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
Sub Aff_Photo()
    Dim Photo As Variant
    Dim Gauche, Sommet, Largeur, Hauteur As Single
 
    Photo = Application.GetOpenFilename("Images JPEG (*.jpg), *.jpg")
    Gauche = Range("F2").Left
    Sommet = Range("F2").Top
    Largeur = Range("F2").Width
    Hauteur = Range("F2").Height
 
    If Photo <> False Then
        Feuil1.Shapes.AddPicture Photo, True, True, Gauche, Sommet, Largeur, Hauteur
    End If
End Sub

[vieuxmonsieur]

Il est également possible d'insérer une image dans un commentaire
Pour faire :
1-Faire clic-droit dans la cellule, "Modifier le commentaire..."

2-Se placer sur le contour de ce dernier, refaire clic-droit et choisir "Format du commentaire..."

3-Dans la boite de dialogue, onglet "Couleurs et trait",
dans le menu déroulant "Remplissage / Couleur", choisir "Motifs et Textures..."

4-Choisir l'onglet "Images" et enfin le bouton "Sélectionner une image..."

[Philippe Tulliez]

Bonjour,
Il existe une solution sans VBA, tu peux faire une recherche sur le net avec comme mots Excel trombinoscope.
SI tu veux une solution en VBA, un tutoriel de Silkyroad à lire Créer un organigramme et un trombinoscope dans Excel

[graphikris]

Bonjour,

J'ai reçu 2 réponses mais elles ne correspondent pas à ce que je voudrais réaliser.

Voici donc mon problème :

J'ai une feuille 1 avec ma base de données.

Dans une feuille 2, j'ai une fonction "rechercheV" qui permet grace à une liste déroulante de sélectionner un "nom-prenom" afin de récupérer certaines donnees dans la feuille1.

Ensuite j'ai un répertoire sur c:\ nommé : identités avec les photos d'identité du personnel. Toutes les photos ont un nommage particulier :
NOM-Prenom-FONCTION-SOCIETE-BATIMENT-M-

Dans ma feuille 2 (rechercheV), je voudrais que la photo de la personne sélectionnée dans la liste déroulante, vienne s'afficher à un endroit précis (de R6 à R10) ce qui correspondant à la taille de la photo d'identité.

Cette feuille 2 est imprimable au format A3 et je souhaiterai que la photo s'imprime également.

Je sais que c'est compliqué mais j'ai beau chercher sur le net, rien ne correspond à ma question.

Merci à ceux ou celles qui auront une réponse.

[Philippe Tulliez]

Bonjour,
Le lien que j'ai donné dans ma dernière intervention Créer un organigramme et un trombinoscope dans Excel n'apporte pas un début de solution ?
Si mes souvenirs sont exacts, ce code va chercher les photos sur le disque dans un répertoire particulier en fonction du nom sélectionné.
Il y a un classeur qui l'accompagne avec les procédures et l'exemple décrit dans le tutoriel.

[graphikris]

Tout d'abord, je souhaite vous présenter mes voeux pour 2013 et que tout Excel chez vous.

Ce msg s'adresse à Mr Tulliez. Vous me dites que dans votre lien, celà m'apportera un début de solution. Mais lorsque je lis le préambule du tutoriel, il est écrit :
1 - Vous pourrez visualiser dans un UserForm la structure organisationnelle d'une équipe de travail

2 - Vous pourrez retrouver le nom d'une personne à partir de sa photo

Par rapport au (1), je n'utilise pas de Userform mais tout simplement une feuille de calcul et ensuite par rapport au (2), je désire faire l'inverse, càd retrouver une photo par rapport à un nom.

J'ai bien lu le tuto, mais il ne correspond pas à ce que je dois réaliser.

Sinon je vous remercie pour le temps de recherche et d'aide que vous apporter à ceux qui n' Excel pas à fond (comme moi).

En espérant que vous pouvez plus amplement éclairer ma lanterne car je suis dans le mur.

Encore bonne année 2013
Cordialement.

[Philippe Tulliez]

Bonjour,
J'allais te dire d'utiliser l'enregistreur de macro parce-qu'avec Excel 2010, on peut faire un remplacement d'une image existante.
La gestion des images dans excel n'est pas du tout loin de là ma spécialité donc après quelques recherches voici une petite ébauche qui je l'espère te permettra d'avancer dans ton projet.
Le fichier attaché contient :
-Un classeur nommé Trombi_DataBase
-Un répertoire Photo contenant trois images.
Le classeur contient deux feuilles.
L'une nommée db contient trois champs Nom, Prénom et la concaténation des deux pour éviter les homonymes.
La deuxième nommée Consultation contient :
-Une Validation de données - Liste permettant de sélectionner la référence
-Une image
-Deux cellules contenant le nom et prénom sélectionné et qui est le résultat de la fonction Recherchev
Le classeur contient une procédure dont le code me fait rougir de honte avec ses Select, Selection etc....
J'ai fait des tests en 2003 et 2010 et le comportement n'est pas le même (Format de l'image plus petite en 2003 qu'en 2010 (en fait elle a atteint une taille énorme en 2010 que j'ai rectifié).
Il y a donc lieu à mon avis de lire les propriétés de l'image avant de la supprimer pour l'appliquer à la nouvelle image insérée.
La procédure événementielle

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim pId As String: pId = "PhotoId"
  Dim myPicture As Picture
  Select Case Target.Address
   Case Range("NameSelected").Address
     Dim Pic As Picture
     On Error Resume Next
     Me.Pictures(pId).Delete
     On Error GoTo 0
     Range("PictureSpace").Select
     Set Pic = Me.Pictures.Insert(Me.Parent.Path & "\Photos\" & Target.Value & ".jpg")
     Pic.Name = pId
     ActiveSheet.Shapes(pId).Select
     Selection.ShapeRange.ScaleWidth 2.35, msoFalse, msoScaleFromTopLeft
     Selection.ShapeRange.ScaleHeight 2.36, msoFalse, msoScaleFromTopLeft
     Target.Select
  End Select
End Sub

La technique utilisée
1) Choisir une cellule de référence (Ici B8) et la nommer PictureSpace
2) Insérer une image
3) Sélectionner cette image
a) la renomner PhotoId
b) Dans la barre des formules taper = PictureSpace
4) Ecrire le code (celui présenté ci-dessus) dans l'objet feuille Consultation

Donc en résumé. En sélection dans la liste se trouvant en B2 l'image sera changée.

Il faut donc maintenant améliorer cette procédure et j'espère tu nous en feras profiter.

Bonjour,
Voici une nouvelle version de la procédure événementielle qui a l'avantage de replacer l'image à la position et à la dimension d'origine.
Il reste encore à régler le problème du Select

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Sub Worksheet_Change(ByVal Target As Range)
 Const PictName As String = "PhotoId"
 Const PictRefRange As String = "PictureSpace"
 Dim Pic As Picture
 Dim myShape As Shape: Set myShape = Me.Shapes(PictName)
 Dim pTop As Double, pLeft As Double, pHeight As Double, pWidth As Double
 Select Case Target.Address
  Case Range("NameSelected").Address
   With myShape: pTop = .Top: pHeight = .Height: pLeft = .Left: pWidth = .Width: End With
   On Error Resume Next:  Me.Pictures(PictName).Delete: On Error GoTo 0
   Range(PictRefRange).Select
   Set Pic = Me.Pictures.Insert(Me.Parent.Path & "\Photos\" & Target.Value & ".jpg")
   Pic.Name = PictName: Set myShape = Me.Shapes(PictName)
   With myShape: .Top = pTop: .Height = pHeight: .Left = pLeft: .Width = pWidth: End With
   Target.Select
 End Select
End Sub

[Philippe Tulliez]

Bonjour,
Finalement après plusieurs essais, je me suis rendu compte qu'il n'y avait aucune raison de référencer l'image à une cellule (J'avais procédé comme la consultation sans VBA avec les photos sur une autre feuille).
Donc la procédure est plus simple.
Dans la feuille Consultation
1) Insérer une image de base par exemple ImgTest.jpg qui est présente dans le sous-répertoire Photos
2) Sélectionner cette image et la renomner PhotoId

L'image peut être placée n'importe où sur la feuille et redimensionnée à souhait. L'image qui suivra prendra la même place et la même dimension.

J'ai repensé l'ensemble et ai écrit une fonction qui remplacera la photo d'origine par une autre en la nommant à nouveau PhotoId.
La fonction est appelée par la procédure événementielle Worksheet_Change qui elle même est déclenchée par le choix fait à l'aide de la validation de données qui se trouve en cellule B2 nommée NameSelected
La procédure événementielle
Cette procédure à quatre arguments dont un est obligatoire (le nom de l' image à aller chercher dans le répertoire Photos), les trois autres arguments ont des valeurs par défaut.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Option Explicit
Const rngSelectName As String = "NameSelected"
Private Sub Worksheet_Change(ByVal Target As Range)
 Select Case Target.Address
  Case Range(rngSelectName).Address
    If Not (InsertPicture(Target.Value)) Then MsgBox "Problème de modification d'image"
 End Select
End Sub

La fonction InsertPicture

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Function InsertPicture(PictureName As String, Optional OriginalPicture As String = "PhotoId", Optional FolderName As String = "Photos", Optional PictureType As String = ".jpg") As Boolean
 ' Procédure qui insère une image en lieu et place de OriginalPicture
 ' Renvoie TRUE si l'opération s'est bien déroulée
 ' Philippe Tulliez
 ' Version : 0.1
 ' Date : 02/01/2013
 ' Déclaration
 ' Arguments
 ' PictureName       : String Nom de l'image à insérer
 ' [FolderName]      : String Optionnel Nom du sous-Répertoire [d:=Photos]
 ' [PictureType]     : String Type d'image [d:jpg]
 ' [OriginalPicture] : String nom de l'image d'origine [d:PhotoId]
 Const ErrTitle As String = "InsertPicture v0.1"
 Dim FullName As String
 Dim Pic As Picture
 Dim myShape As Shape
 Dim pTop As Double, pLeft As Double, pHeight As Double, pWidth As Double
 ' Construit le chemin où se trouve l'image à modifier
 PictureName = FolderName & "\" & PictureName & PictureType '
 With ThisWorkbook
  FullName = Left(.FullName, InStrRev(.FullName, "\")) & PictureName
 End With
 ' Ctrl Existence du fichier
 If Len(Dir(FullName)) = 0 Then
   MsgBox "Image [" & FullName & "] non présente", vbCritical, ErrTitle
   Exit Function
 End If
 ' Ctrl si l'image dans la feuille
 On Error Resume Next: Set myShape = Me.Shapes(OriginalPicture)
 If Err Then
   MsgBox "L'image [" & OriginalPicture & "] n'est pas présente dans la feuille"
   On Error GoTo 0: Exit Function
 End If
 ' Lit les propriétés de l'image d'origine
 With myShape: pTop = .Top: pHeight = .Height: pLeft = .Left: pWidth = .Width: End With
   On Error Resume Next:  Me.Pictures(OriginalPicture).Delete: On Error GoTo 0
   Set Pic = Me.Pictures.Insert(FullName)
   Pic.Name = OriginalPicture: Set myShape = Me.Shapes(OriginalPicture)
 ' Ecrit les propriétés de l'image d'origine
 With myShape: .Top = pTop: .Height = pHeight: .Left = pLeft: .Width = pWidth: End With
 InsertPicture = True
End Function

Il y a encore moyen d'améliorer cette fonction en faisant une création automatique de la première image d'origine et prévoir des dimensions et positionnement par défaut.

Un fichier compressé avec le classeur DataBase Image.xls qui contient un petit exemple (La photo d'origine est déjà placée, il suffit pour tester de sélectionner dans la liste) Une référence erronée est présente pour le test d'erreur.

[graphikris]

Bonjour,
Déjà un grand merci pour vos réponses. Un réponse à 5 h du mat montre bien que vous êtes un passionné confirmé.

Sinon j'ai quelques pb de compréhension.

1 - Dois je inscrire OPTION EXPLICIT dans toutes mes feuilles ?

2 - Comment faire pour renommer la photo en : "PhotoId" ?

3 - La fonction InsertPicture doit etre placée dans la meme feuille que la procédure événementielle (feuille de recherche) ?

4 - Toutes mes photos n'ont pas le meme nommage que le nom prénom recherché, elles sont nommées de cette manière :

NOM-Prenom-FONCTION-SOCIETE-BATIMENT-M-

5 - Dans la BdD les noms - prénoms sont dans une meme cellule et ecrits de la manière suivante :

NOM Prénom

Sinon encore merci je sens qu'on tient le bon bout.

[Philippe Tulliez]

Bonsoir,

Bonjour,
Déjà un grand merci pour vos réponses. Un réponse à 5 h du mat montre bien que vous êtes un passionné confirmé.

Effectivement, je suis un passionné.

Sinon j'ai quelques pb de compréhension.
1 - Dois je inscrire OPTION EXPLICIT dans toutes mes feuilles ?

Ce n'est pas obligatoire mais hautement recommandé.
Le basic dont VBA est issu a hérité de sa "facilité" de pouvoir utiliser des variables sans les déclarer.
Or si on veut écrire des applications dignes de ce nom, il est important de déclarer ces variables.
Option Explicit est l'option qui indique à VBA que ces déclarations doivent être déclarées et donc le code s'arrête immédiatement s'il rencontre une variable utilisée non déclarée.
Je ne vais pas revenir ici sur la manière de le faire d'une façon automatique, les autres avantages, il y a un tas de tutoriaux sur ce site dont je recommande la lecture.

2 - Comment faire pour renommer la photo en : "PhotoId" ?

Il suffit de sélectionner l'objet et de le renommer dans la zone des noms.

3 - La fonction InsertPicture doit etre placée dans la meme feuille que la procédure événementielle (feuille de recherche) ?

Oui ou dans l'objet ThisWorkbook mais alors il s'agit d'une autre procédure événementielle.

4 - Toutes mes photos n'ont pas le meme nommage que le nom prénom recherché, elles sont nommées de cette manière :NOM-Prenom-FONCTION-SOCIETE-BATIMENT-M-

Le but des interventions sur Développez.com n'est pas de faire le travail à la place des personnes qui posent des questions. J'ai déjà été très loin avec la fonction que j'ai écrite.
En général beaucoup parmi nous et j'en suis, vivent de type de travail. On donne des pistes, c'est tout.
Il suffit donc de prévoir dans la base de données du personnel qui est ici représentée par la feuille bd, une zone où l'on placera le nom du fichier automatique. Cela peut-être une valeur fixe, soit le résultat de la concaténation de plusieurs champs. Je l'ai d'ailleurs évoqué dans mes interventions.

5 - Dans la BdD les noms - prénoms sont dans une meme cellule et ecrits de la manière suivante :
NOM Prénom

Voir ce que j'ai décrit plus haut.

Sinon encore merci je sens qu'on tient le bon bout.

Ce type de travail n'est pas énorme mais demande une connaissance minimum du VBA, de la persévérence, de la lecture et évidemment de l'expérience ensuite pour écrire de belle procédure.
Mais surtout, et je ne le répéterais jamais assez une très bonne connaissance des possibilités d'excel.
Je vois malheureusement souvent des personnes voulant écrire en VBA ce qu'Excel propose nativement.
Cette bonne connaissance permet parfois d'écrire deux lignes de codes là où d'autres pondent des usines à gaz et je ne parle pas de la maintenance ensuite.
Si je donne autant, c'est que j'ai reçu aussi beaucoup à mes débuts mais j'ai travaillé beaucoup, me suis documenté beaucoup, et appliqué ce que l'on m'a enseigné.
Il n'y a pas de secret c'est comme tout, Travail, travail, travail.
Vingt fois sur le métier remettez votre ouvrage,
Polissez-le sans cesse, et le repolissez,
Ajoutez quelquefois, et souvent effacez. (Nicolas Boileau)

[SIOUDI]

Bonjour,
Voici un programe VB qui peut être utile.
merci d'inserer le chemin du répértoir dont vous enregistrer les photos.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim a As Double, b As Double
  If Not Intersect(Target, Range("C5")) Is Nothing Then
    répertoire = "........................................."
    On Error Resume Next
    ActiveSheet.Shapes("monimage").Delete
    Set img = ActiveSheet.Pictures.Insert(répertoire & "\" & Range("C5") & ".jpg")
    img.Name = "monimage"
'    img.Left = [a1].Left
'    img.Top = [a1].Top
'    img.Width = [a1].Width
'    img.Height = [a1].Height + [a2].Height + [a3].Height
 
    a = img.Height / img.Width
    b = ([a1].Height + [a2].Height + [a3].Height + [a4].Height) / [a1].Width
    img.Top = [b1].Top
    img.Left = [a1].Left
    If b < a Then
        img.Height = ([a1].Height + [a2].Height + [a3].Height + [a4].Height)
        img.Width = [a1].Width * b / a
    Else
        img.Width = [a1].Width
        img.Height = ([a1].Height + [a2].Height + [a3].Height) * a / b
    End If
 
  End If
End Sub

NB :les photos et la cellule de recherche doivent avoir le même nom.
de préférence faire la liaison à une liste déroulante mieu qu'une formule de recherche V.

N'oublier par "résolu"