Intégration photo via macro

Résolu/Fermé

Porthos44 Messages postés 5 Date d'inscription mardi 25 février 2020 Statut Membre Dernière intervention 26 février 2020 - 25 févr. 2020 à 15:34
Porthos44 Messages postés 5 Date d'inscription mardi 25 février 2020 Statut Membre Dernière intervention 26 février 2020 - 26 févr. 2020 à 10:30

Bonjour,

Je bloque sur la mise en place d'une photo sur un document (titre d'habilitation) en fonction de 2 variables qui sont le NOM et le prénom de la personne.
N'étant que très peu aguerri sur l'utilisation du VBA j'aurai besoin d'une aide charitable s'il vous plait.
Les deux variables sont les cellules fusionnées E6(NOM) et E10 (Prenom)
Le fichier source est dans un répertoire et les photos sont rangées dans un sous répertoire au nom des collaborateur (NOM Prénom). Les photos sont nommées : NOM Prénom PH.jpg
Je souhaiterai intégrer la photo dans les colonnes D4 à D13.

Il m'est difficile de modifier le document celui contenant pas mal de formule pour reprendre les données en automatique.

Merci pour votre aide !

A voir également:

Intégration photo via macro
Traduction photo gratuit - Guide
Photo de profil - Guide
Partage photo - Guide
Photo aérienne de ma maison - Guide
Macro word - Guide

5 réponses

Réponse 1 / 5

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
25 févr. 2020 à 15:48

Bonjour,

voir ici la marche à suivre:

http://boisgontierjacques.free.fr/pages_site/lesimages.htm#InsertionImage

Réponse 2 / 5

Porthos44 Messages postés 5 Date d'inscription mardi 25 février 2020 Statut Membre Dernière intervention 26 février 2020
25 févr. 2020 à 16:31

Bonjour,

Merci pour ce retour qui m'a déjà bien aidé à mieux cerner la codification.

J'ai essayé ceci, mais voici l'erreur sur laquelle je bloque :

Private Sub CmdPhoto_Click()

Emplacement = "U:\DOSSIERS PERSONNELS\VIGNEUX-DE-BRETAGNE\PHOTOS\"
Nom = Range("F1").MergeArea
Set c = Range("D4").MergeArea
With ActiveSheet
.Pictures.Insert(Emplacement & Nom & ".jpg").Name = Nom
.Shapes(Nom).Left = c.Left
.Shapes(Nom).Top = c.Top
.Shapes(Nom).LockAspectRatio = msoFalse
.Shapes(Nom).Height = c.Height
.Shapes(Nom).Width = c.Width
End With

End Sub

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
Modifié le 25 févr. 2020 à 17:30

Les photos sont nommées : NOM Prénom PH.jpg

D'après la capture d'écran le nom de l'image se trouve en E?(je ne vois pas le numero de ligne) et le prénom en E?(je ne vois pas le numero de ligne) et il n'y a rien en F1!

donc c'est normal le chemin de l'image ne correspond pas, il manque le nom de l'image!

Nom = Range("E?" & "E?" & "PH")

il faut que cela corresponde à l'espace près au nom de l'image!

Voilà

@+ Le Pivert

Réponse 3 / 5

Porthos44 Messages postés 5 Date d'inscription mardi 25 février 2020 Statut Membre Dernière intervention 26 février 2020
25 févr. 2020 à 17:42

Après plusieurs test le problème vient effectivement de là. Mais il semblerait que les accents posent problème d'après mon test. Est-ce le cas ? (J'ai retiré les PH pour me simplifier le code).

En F1 j'ai une fonction CONCATENER(E6;E10) qui n'apparait pas pour des raisons de mise en forme. Elle me permet un RECHERCHEV sur l'ensemble des onglets du classeur.

Dans le cas de mon problème cette cellule renvoie donc (DEBRISGéraldine). Or en testant la macro avec un : Nom = "DEBRISGéraldine" cela ne marche pas alors qu'avec Nom="DEBRISGeraldine" cela fonctionne parfaitement.

Dois-je trouver une solution pour retirer les accents ?

Je vais tester de nouveau une solution complète mais ayant déjà tester cette dernière solution je reste bloqué !

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
25 févr. 2020 à 17:50

Je pense que la solution est d’enlever les accents

Voir cela pour les fichiers images:

https://www.commentcamarche.net/informatique/windows/235-renommer-plusieurs-fichiers-a-la-fois-dans-windows/

et ceci pour le classeur Excel:

https://silkyroad.developpez.com/VBA/ManipulerChainesCaracteres/#LI-J

@+ Le Pivert

Réponse 4 / 5

Porthos44 Messages postés 5 Date d'inscription mardi 25 février 2020 Statut Membre Dernière intervention 26 février 2020
26 févr. 2020 à 09:07

Bonjour,

J'ai finalement réussi en travaillant différemment :

J'ai créé une nouvelle liste référentielle afin d'affecter une nomenclature chiffrée à chaque personne ce qui me simplifie la recherche de référence mais m'a obligé à renommer les photos. N'étant pas très nombreux cela ne m'a pas pris beaucoup de temps.

Private Sub CmdPhoto_Click()

Dim Nom As String

Emplacement = "U:\DOSSIERS PERSONNELS\04 PHOTOS\"
Nom = Range("P8")
Set c = Range("D4").MergeArea

With ActiveSheet
.Pictures.Insert(Emplacement & Nom & ".jpg").Name = Nom
.Shapes(Nom).Left = c.Left
.Shapes(Nom).Top = c.Top
.Shapes(Nom).LockAspectRatio = msoFalse
.Shapes(Nom).Height = c.Height
.Shapes(Nom).Width = c.Width
End With

End Sub

Par contre je souhaiterai pouvoir effacer les anciennes photos dans le code afin de remplacer par la nouvelle sans garder l'ancienne. Cela évite d'avoir à le faire à la main. J'ai la fonction je pense mais je n'arrive pas à la faire fonctionner.

Private Sub CmdPhoto_Click()

Dim Nom As String

Emplacement = "U:\DOSSIERS PERSONNELS\04 PHOTOS\"
Nom = Range("P8")
Set c = Range("D4").MergeArea

With ActiveSheet
.Shapes(Nom).Delete
.Pictures.Insert(Emplacement & Nom & ".jpg").Name = Nom
.Shapes(Nom).Left = c.Left
.Shapes(Nom).Top = c.Top
.Shapes(Nom).LockAspectRatio = msoFalse
.Shapes(Nom).Height = c.Height
.Shapes(Nom).Width = c.Width
End With

End Sub

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
26 févr. 2020 à 09:11

Toujours chez Boisgontier:

http://boisgontierjacques.free.fr/pages_site/lesimages.htm#Suppression

@+ Le Pivert

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

Posez votre question

Réponse 5 / 5

Porthos44 Messages postés 5 Date d'inscription mardi 25 février 2020 Statut Membre Dernière intervention 26 février 2020
26 févr. 2020 à 10:30

C'est parfait, cela fonctionne merci cs_Le Pivert ! :)

Discussions similaires

Pix

Discussions similaires

Newsletters