[Toutes versions] inserer images dans excel vba [Résolu]

[gilt83]

Bonjour a toutes et tous.

je suis nouveau sur le forum et comme il est encore temps:
Je vous souhaite une très bonne et heureuse ANNÉE 2012

voila mon "problème", j'ai dans un classeur excel un onglet nommé Liste et un autre nommé REPERTOIRE, dans REPERTOIRE j'ai une foule de renseignements du style: NOM/PRENOM/ORIGINE/DATE DE NAISSANCE/ADRESSE/CODE POSTAL/VILLE/N° TEL/ etc etc j'ai environ 200 colonnes correspondant a 200 renseignements et 160 lignes correspondant a 160 personnes. Tous ces renseignements sont dans Liste.Dans REPERTOIRE j'aimerais afficher la photo de la personne qui m'interresse dans la cellule fusionnée M-N 2-3-4-5 et aussi dans la cellule fusionnée M-N 97-98-99-100. les photos se trouvent dans un autre dossier
merci pour votre aide et j'ai aucune connaissance en VBA
PS: je peut vous mettre un exemple de mon fichier excel

[BlueMonkey]

Bonsoir,

Bonne année également.

Avec la méthode InsertPicture(<chemin et nom du fichier image>, Range("Mx:Nx+3")) présenté >>ici<< tu devrais avoir un bon début.

[gilt83]

merci pour ta reponse mais je n'y connais rien en vba et en plus en langue étrangère
@+

[BlueMonkey]

Le site précédent est effectivement en anglais.
Mais le code de la fonction utile représente 90% de la page.
L'idée était de faire un copier/coller de la fonction InsertPicture, puis de l'adapter.

Pour aider plus précisément, il faudrait savoir :
- quelle est la version d'Excel utilisée (2000, 2003, 2007, 2010) ?
- dans quel dossier exactement se trouvent les photos. ?
- quels est le format des images (jpg, png, bmp ...)
- est-ce que les noms de images sont régulières <nom><prénom>, ou bien aléatoire 0001.jpg, 0002.jpg ....
- Dans ce cas, est ce qu'il y a une liste de correspondance, entre nom de fichier et personne correspondante
ou bien ligne à laquelle il faut insérer ce fichier

[gilt83]

bonsoir
pas pu repondre avant:
chez moi c excel 2007 et au boulot c excel 2003
les photo sont en jpg
les photo on les noms des personnes
les photos seront dans C /mes documents/ photos/ (nom des personnes)
mais si vous voulez je vous envoie un modele
encore merci

[BlueMonkey]

Bonsoir,

Si vous voulez, je vous envoie un modele

Je pense qu'un modèle vide (juste titre et format de ligne/colonne) serait utile ici.
(sans connaissance en VBA, vous aurez du mal à transposer les extrait de code qu'on vous enverrais ).

les photo on les noms des personnes
les photos seront dans C /mes documents/ photos/ (nom des personnes)

Donc si on utilise l'info dans la colonne nom, on peut exactement
(le code c'est pas très tolérant sur les erreurs de frappe )
reconstituer le nom de l'image ?

[gilt83]

rebonsoir,

En fait dans l'onglet REPERTOIRE il y a une liste déroulante qui est en rapport avec la celulle G5 dedant il y a le chiffre 156 je ne sais pas a quoi cela correspond je suis désolé peut être que je m'explique mal:
voici mon adresse mail ( ] ) envoyer moi un message en privé et en retour je vous enverrer mon modèle c peut être plus simple?

merci encore de prendre sur votre temps pour vouloir m'aider

[BlueMonkey]

Re.

J'ai noté l'adresse email en cas de besoin.
Mais pour ne pas avoir de spam en pagaille, je vous recommande vivement d'éditer votre message et de la retirer.

Le forum dispose de fonction d'ajout de fichier. (voir <gérer les pièces> jointes)
Si le modèle est vide de données personnelles, est ce qu'il vous est possible d'utiliser ce moyen ?
(De cette manière d'autres membres du fourm pourront aider ).

[gilt83]

je vous envoie un exemple en piece jointe
merci

[BlueMonkey]

En résumé, lorsque la valeur de la liste à choix multiple Rechercher les coordonnées de : change,
il faut charger une image, et la mettre dans les plages :
- M2:N5
- M100:N103

Cette image se trouve dans C:\mes documents\photos
et se nomme : <nom de la colonne A , feuille "Liste">.jpg

C'est ça ?

[gilt83]

Oui c tout a fait cela

[BlueMonkey]

Bonjour,

A partir du fichier précédent, il faut :

1) Entrer le nom du dossier où se trouve les images dans l'onglet "répertoire" cellule J5.
ex : C:\Documents and Settings\<Mon login>\My Documents\Images
(éventuellement choisir la même couleur de police que de fond pour masquer cette info.)


2) Copier / coller le code ci-dessous dans la feuille REPERTOIRE sous l'éditeur VBA.

- Pour lancer l'éditeur, <ALT> + <F11>.
- Depuis l'explorateur de projet, sélectionner Objet Microsoft Excel
- Double cliquer sur l'objet feuil13"Repertoire"
- Coller dans cette feuille le code ci-dessous.

Code :

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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Option Explicit
 
Const PH_1 As String = "Photos1"          'nom donné à la photos n°1
Const PH_1_RG As String = "M2:N5"         'Emplacement de la photo
Const PH_2 As String = "Photos2"          'nom donné à la photos n°2
Const PH_2_RG As String = "M100:N103"     'Emplacement de la photo
Const PH_DIR As String = "J5"             'Emplacement du dossier contenant les imges
Const NAME_OFFSET As String = "G5"        'Emplacement de l'index du nom sélectionné
Const RG_NAMES As String = "C4:C160"      'Emplacement de la liste des noms
Const RG_NAMES_WS As String = "Liste"     'Feuille contenant les noms
 
Public Sub Nom_OnChange()
    Dim photoFilename As String
    photoFilename = GetCurrentPictFilename()
 
    If Len(Dir(photoFilename)) = 0 Then ' si pas de fichier image
          If DoesPictExist(PH_1) Then ActiveSheet.Pictures(PH_1).Delete
          If DoesPictExist(PH_2) Then ActiveSheet.Pictures(PH_2).Delete
          Exit Sub
    End If
 
    Application.ScreenUpdating = False
    Call LoadPict(PH_1, photoFilename, Range(PH_1_RG))
    Call LoadPict(PH_2, photoFilename, Range(PH_2_RG))
    Application.ScreenUpdating = True
 
End Sub
 
Private Function DoesPictExist(PictName As String) As Boolean
    DoesPictExist = False
 
    Dim p As Object
    For Each p In Pictures
        If p.Name = PictName Then
            DoesPictExist = True
            Exit For
        End If
    Next p
End Function
 
Private Sub LoadPict(PictName As String, filename As String, r As Range)
    If DoesPictExist(PictName) Then
        ActiveSheet.Pictures(PictName).Delete
    End If
 
    With ActiveSheet.Pictures.Insert(filename)
        .Name = PictName
        .Left = r.Left + 1
        .Top = r.Top
        .Width = r.Cells(1, r.Columns.Count).Left - r.Left + r.Columns(1).Width - 1
        .Height = r.Cells(r.Rows.Count, 1).Top - r.Top + r.Rows(r.Rows.Count).Height
    End With
End Sub
 
Private Function GetCurrentPictFilename() As String
    GetCurrentPictFilename = CStr(Range(PH_DIR).Value) & "\" & GetCurrentName & ".jpg"
End Function
 
Private Function GetCurrentName() As String
    GetCurrentName = Worksheets(RG_NAMES_WS).Range(RG_NAMES).Cells(CInt(Range(NAME_OFFSET).Value), 1).Value
End Function

3) Sous Excel, feuille "répertoire",
clic droit sur le menu de sélection de nom (proche de G5).
Choisir affecter une macro, sélectionner la macro Feuil13.Nom_OnChange.



Au prochain changement de nom, les photos devraient s'afficher.

[gilt83]

merci
je vais essayer mais je n'en suis pas sur

[BlueMonkey]

Bonjour,

mais je n'en suis pas sur

Sûr de quoi ?
Si c'est d'arriver à faire les modifications, je viens d'ajouter le fichier modifier à mon message précédent.

[gilt83]

Excellent,

Merci et respect pour ton travail qui mérite toute ma gratitude

Ca marche a MERVEILLE

Merci merci BEAUCOUP

PARDON J'AVAIS PAS VUS LA PIECE JOINTE MAIS J'Y SUIS ARRIVER DONC JE PROGRESSE DOUCEMENT MAIS SUREMENT
ENCORE PARDON ET MILLE MERCI

[BlueMonkey]

Content que ça ces quelques lignes aient permis de rendre plus convivial ce fichier déjà très complet

Bonne journée.

P.S. : Il ne reste plus qu'à noter le sujet résolu (avec le p'tit bouton <Résolu>) , et éventuellement plussoyer la réponse qui a fonctionné

[Edit] : Je n'avais pas mis le fichier joint initialement, justement pour inciter à la progression.
Tu t'en ai très bien tiré.

[gilt83]

Merci encore
Ne pas lacher un travail est important et en plus quand on met la touche finale a son projet (merci pour ton aide) on ne peut que continuer et avancer.
Bonne fin de week-end
Merci au forum de vivre de grands moments