Intégration photo via macro

[Résolu/Fermé]
Signaler
Messages postés
5
Date d'inscription
mardi 25 février 2020
Statut
Membre
Dernière intervention
26 février 2020
-
Messages postés
5
Date d'inscription
mardi 25 février 2020
Statut
Membre
Dernière intervention
26 février 2020
-
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 !

5 réponses

Messages postés
7545
Date d'inscription
jeudi 13 septembre 2007
Statut
Non membre
Dernière intervention
26 septembre 2021
659
Messages postés
5
Date d'inscription
mardi 25 février 2020
Statut
Membre
Dernière intervention
26 février 2020

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


Messages postés
7545
Date d'inscription
jeudi 13 septembre 2007
Statut
Non membre
Dernière intervention
26 septembre 2021
659
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
Messages postés
5
Date d'inscription
mardi 25 février 2020
Statut
Membre
Dernière intervention
26 février 2020

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é !
Messages postés
7545
Date d'inscription
jeudi 13 septembre 2007
Statut
Non membre
Dernière intervention
26 septembre 2021
659
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
Messages postés
5
Date d'inscription
mardi 25 février 2020
Statut
Membre
Dernière intervention
26 février 2020

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
Messages postés
7545
Date d'inscription
jeudi 13 septembre 2007
Statut
Non membre
Dernière intervention
26 septembre 2021
659
Messages postés
5
Date d'inscription
mardi 25 février 2020
Statut
Membre
Dernière intervention
26 février 2020

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