Photo Userform vers Excel

Résolu

romanza Messages postés 249 Date d'inscription Statut Membre Dernière intervention -
pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention - 3 juin 2015 à 12:39

Bonjour,
J'alimente une base de données simple sur excel (Nom, Prénom, etc,..) à partir d'un UserForm servant de formulaire.
Je souhaite ajouter une photo par fiche qui s'afficherait dans la colonne "E".

Dans le Userform, j'ai crée un bouton qui permet de choisir une photo dans le disque dur et de la plaquer sur l'Image1 du Userform;le code est le suivant :

Private Sub Ajouter_photo_Click()
   NDFPhoto = Application.GetOpenFilename
    On Error Resume Next
    Me.Image1.Picture = LoadPicture(NDFPhoto)
End sub

Jusque là pas de souci mais je n'arrive pas à plaquer cette même image dans la cellule excel de la colonne "E"correspondante.

Le code pour enregistrer une nouvelle fiche est le suivant

Private Sub Enregistrer_Click()

Sheets("Résidents").Select
Rows("3:3").Select

Selection.Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
If MsgBox("Confirmez-vous l'ajout des données?", vbYesNo, "Confirmation") = vbYes Then

Cells(3, 1) = ComboBoxCivilité.Value
Cells(3, 2) = NOM.Value
Cells(3, 3) = Prénom.Value
Cells(3, 4) = Néle.Value
Cells(3, 5) = NDFPhoto

Selection.Font.Bold = False
Unload UserForm1
Load UserForm1
UserForm1.Show

                End If           
  End Sub

Avec ce code en colonne "E", je n'ai que l'adresse de l'image alors que je souhaiterais avoir l'image redimensionnée en hauteur de ligne de 75.
Pouvez-vous m'indiquer le code qui va bien.

Merci à vous

A voir également:

Photo Userform vers Excel
Google photo - Télécharger - Albums photo
Liste déroulante excel - Guide
Word et excel gratuit - Guide
Google maps photo maison - Guide
Photo filtre 7 gratuit - Télécharger - Retouche d'image

11 réponses

Réponse 1 / 11

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Bonjour,

1- déclare ta variable NDFPhoto en entête du module de l'userform
2- tes codes devraient être comme ceci :

Dim NDFPhoto As String

Private Sub Ajouter_photo_Click()
    NDFPhoto = Application.GetOpenFilename
    On Error Resume Next
    Me.Image1.Picture = LoadPicture(NDFPhoto)
End Sub

Private Sub Enregistrer_Click()
Sheets("Résidents").Select
Rows("3:3").Select
Selection.Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
If MsgBox("Confirmez-vous l'ajout des données?", vbYesNo, "Confirmation") = vbYes Then
   Cells(3, 1) = ComboBoxCivilité.Value
   Cells(3, 2) = NOM.Value
   Cells(3, 3) = Prénom.Value
   Cells(3, 4) = Néle.Value
   With ActiveSheet.Pictures.Insert(NDFPhoto)
      .Top = Cells(3, 5).Top
      .Left = Cells(3, 5).Left
      'ici tu peux préciser la taille
      '.Width = 20
      '.Height = 15
   End With
   Selection.Font.Bold = False
   Unload UserForm1
   Load UserForm1
   UserForm1.Show
End If           
End Sub

Réponse 2 / 11

romanza Messages postés 249 Date d'inscription Statut Membre Dernière intervention 2

Merci pijaku pour ton retour.
Mais j'ai un bug.

J'ai recopié ton code mais je crois que mon erreur est de pas savoir positionner la variable NDFPhoto en entête du module de l'userform .

Je te joins mon fichier, je pense que cela sera plus explicite. Les photos à appliquer dans la feuille excel doivent être positionnées en fait dans la colonne AU
https://www.cjoint.com/?3ECpWEpFj5T
Merci à toi

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Oui, tu l'as mis dans une Sub.
la déclaration Dim NDFPhoto As String doit être la première ligne de ton module. Au dessus de Private Sub ComboBox1_Change()
En haut du module et en dehors de toute procédure ou fonction.

Réponse 3 / 11

romanza Messages postés 249 Date d'inscription Statut Membre Dernière intervention 2

J'avais essayé cette position mais ce qu'il se passe est que quand on omet d'ajouter une photo à partir du Userform ça bug sur
"With ActiveSheet.Pictures.Insert(NDFPhoto)". il faudrait peut-être ajouter un code if "pas de photo"

Autrement ça fonctionne.

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Bonjour,

il faudrait peut-être ajouter un code if "pas de photo"

Ben oui.
Fais ça.

Le code pour if "pas de photo" est :

If Not Me.Image1.Picture Is Nothing Then

à ajouter à ta macro comme ceci :

If Not Me.Image1.Picture Is Nothing Then
   With ActiveSheet.Pictures.Insert(NDFPhoto)
      .Top = Cells(3, 5).Top
      .Left = Cells(3, 5).Left
      'ici tu peux préciser la taille
      '.Width = 20
      '.Height = 15
   End With
End If

Réponse 4 / 11

romanza

Ok
Je suis en déplacement et je check ça lundi.
Je reviens vers toi.
Merci!

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 11

romanza Messages postés 249 Date d'inscription Statut Membre Dernière intervention 2

Bonjour pijaku,

C'est donc Ok pour ta dernière modif.
Par contre où je bute encore c'est dans mon formulaire userform qui ne m'affiche pas la photo quand je vais chercher une fiche avec le bouton "Recherche" (CommandButton2). J'ai bien essayé :Image1.Picture = LoadPicture(NDFPhoto) (voir par ailleurs le code) mais aucune image apparait.
dans la feuille excel les photos apparaissent dans la colonne "AU" soit le n° de ligne 47

Private Sub CommandButton2_Click()

Dim no_ligne As Integer


no_ligne = ComboBox1.ListIndex + 3
  ComboBoxCivilité.Value = Cells(no_ligne, 1).Value
  NOM.Value = Cells(no_ligne, 2).Value
Prénom.Value = Cells(no_ligne, 3).Value
'...
'...
Ressources.Value = Cells(no_ligne, 44).Value
Montant.Value = Cells(no_ligne, 45).Value
Profession.Value = Cells(no_ligne, 46).Value
Image1.Picture = LoadPicture(NDFPhoto)

   
Enregistrer.Locked = True
Enregistrer.Enabled = False
Nouvellefiche.Enabled = True

End Sub

Romanza

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Bonjour,

Peux tu joindre ton fichier tel qu'il est maintenant?

Réponse 6 / 11

romanza Messages postés 249 Date d'inscription Statut Membre Dernière intervention 2

Voilà,

http://www.cjoint.com/c/EFcmzsheLdi

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Donc...
2 choix :
1- Simplement :
Lors de l'enregistrement de la photo (bouton enregistrer) : noter, dans la cellule, le chemin de l'image :

 With ActiveSheet.Pictures.Insert(NDFPhoto)
      .Top = Cells(3, 47).Top
      .Left = Cells(3, 47).Left
      'ici tu peux préciser la taille
      .Width = 65
      .Height = 65
   End With
   Cells(3, 47) = NDFPhoto
   End If

On peut le cacher en changeant le format de la colonne 47. Suffit de régler la couleur de police et le fond sur blanc...
Lors de l'appel par clic sur le bouton recherche, on ajoute :

Me.Image1.Picture = LoadPicture(Cells(no_ligne, 47).Value)

2- méthode complexe :
- tu boucles sur tous les Shapes de ta feuille
- Si ShapeEnCours.Top = maLigne.Top => c'est la bonne image
- on utilises une fonction de copie/collage d'image de shape dans userform

Tu choisis quoi???

romanza Messages postés 249 Date d'inscription Statut Membre Dernière intervention 2 > pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention

Je choisis la méthode simple.

Par contre je m'aperçois qu'après avoir afficher une fiche, si l'on veut modifier la photo (erreur ou photo plus récente), il faut pouvoir faire un annule et remplace avec le bouton "Ajouter photo".

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761 > romanza Messages postés 249 Date d'inscription Statut Membre Dernière intervention

Grrrrr.........
Comme dis précédemment :

Cells(3, 47) = NDFPhoto

Réponse 7 / 11

romanza Messages postés 249 Date d'inscription Statut Membre Dernière intervention 2

Oui j'ai bien mis Cells(3, 47) = NDFPhoto dans l'enregistrement comme tu me l'a indiqué mais...
1) je recherche une fiche
2) la fiche s'affiche sur le formulaire avec la photo
3) je clique sur "Ajouter photo" pour la changer
3) je clique sur "Modifier"
Dans la cellule excel, la nouvelle photo vient se superposer sur la première.
Est ce dans la sub du bouton d'ajout photo il ne doit pas y avoir un code du type : "si la fiche présente déjà une photo, alors la supprimer"?

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Bonjour,

Oui, tu as raison.
Peux tu me faire passer un fichier déjà fait avec quelques images?
Remplace les photos par d'autres, bien entendu, à des fins d'anonymat...

Réponse 8 / 11

romanza Messages postés 249 Date d'inscription Statut Membre Dernière intervention 2

Bonjour pijaku,

Voilà :

https://www.cjoint.com/c/EFdidvmyimi

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Bonjour,

Voilà ton fichier.
Je t'ai créé une Sub Si_Deja_Photo_Alors_Supprime_La, qui fait ce que son nom indique... lol

Sinon, j'ai également passé un quart d'heure à indenter ton code correctement.
Il était illisible. Il l'est davantage...

Réponse 9 / 11

romanza Messages postés 249 Date d'inscription Statut Membre Dernière intervention 2

Ok, je pars en réunion et je regarde..;Merci

Réponse 10 / 11

romanza Messages postés 249 Date d'inscription Statut Membre Dernière intervention 2

merci pour tout pikaju, c'est ce que je souhaitais.
Dernière requête la photo dans la cellule est placée en haut et à gauche avec le code :
With .Pictures.Insert(NDFPhoto)
.Top = Cells(3, 47).Top
.Left = Cells(3, 47).Left

Comment je fais pour la centrer au milieu de la cellule;

merci à toi

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Surtout tu ne la centres pas verticalement!
Pour que tes macros fonctionnent il faut que le Top de ton image soit égal au top de la cellule.

Pour la centrer horizontalement, c'est un peu d'arithmétique de base non?
Le left de ton image est égal au left de la cellule + (Width de la cellule - Width de l'image) / 2

Réponse 11 / 11

romanza Messages postés 249 Date d'inscription Statut Membre Dernière intervention 2

ok merci ncore

Romanza

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

de rien
A++

Votre réponse