Intégration photo via macro Résolu/Fermé

Question

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 !

cs_Le Pivert · Answer

Bonjour,

voir ici la marche à suivre:

http://boisgontierjacques.free.fr/pages_site/lesimages.htm#InsertionImage

Porthos44 · Answer

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").MergeAreaSet c = Range("D4").MergeAreaWith 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.WidthEnd WithEnd Sub

Porthos44 · Answer

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é !

Porthos44 · Answer

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 StringEmplacement = "U:\DOSSIERS PERSONNELS\04 PHOTOS\"Nom = Range("P8")Set c = Range("D4").MergeAreaWith 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.WidthEnd WithEnd 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 StringEmplacement = "U:\DOSSIERS PERSONNELS\04 PHOTOS\"Nom = Range("P8")Set c = Range("D4").MergeAreaWith 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.WidthEnd WithEnd Sub

Porthos44 · Answer

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