Aide macro insertion image

Bonsoir à tous,
Je viens à vous pour trouver une solution à mon problème de macro. Je me suis mis à la programmation VBA depuis très peu de temps et j'ai encore beaucoup de mal avec.
Voici mon problème, j'ai des images dans un dossier sur un disque dur externe (Chemin P:\HISTOIRE\EMPEREURS ET IMPERATRICES\JAPON) et je souhaite les insérer dans un commentaire sur excel.
Pour l'instant, je suis parvenu à dimensionner et à insérer les images à l'identique dans les commentaires via une macro VBA.

Cependant certaines images ne se re-dimensionnent pas (toutes sont pourtant .jpg), je ne comprends pas le problème.

16test.zip (834.59 Ko)

Ensuite, je dois à chaque fois relancer la macro pour quelle ouvre le dossier et que je puisse choisir l'image. Je souhaiterai que la macro se lance automatiquement afin que l'insertion du commentaire et donc de l'image se fassent eux aussi automatiquement par rapport au contenu de la cellule.

Pour information les images ont le même nom que le contenu de la cellule sur lesquelles elles doivent se positionner. Les liens dans les cellules sont des liens hypertextes (Biographie des personnes).

J'espère avoir été assez clair dans mes explications.

Je vous joins le fichier, cela vous permettra de visualiser mon souci.

Merci par avance pour votre aide.

bonjour Horus-Sebmeb,

j'ai ajouté une macro "M_Japon" qui boucle votre colonne B. Cela fonctionne ?

12test-6.zip (829.41 Ko)

Bonsoir,

J'ai fini le fichier Japon manuellement cela a été fastidieux a tous les niveaux, j'ai entré manuellement toutes les images en relançant la macro.

Certaines images ne se re-dimensionnent pas bien qu'elles soient toutes en jgp. Je pense que cela vient du fait qu'elles soient plus larges que hautes donc le code VBA ne s'exécute pas. Je verrai cela plus tard car incident sur 2 ou 3 images seulement sur un peu moins de 150 images.

Le temps passer sur ce fichier provient du fait que je suis allé chercher toutes les dates via en.wikipédia.org et que j'ai entré ces données manuellement. J'essaye de créer une macro qui extraira les dates qui seront insérer directement dans les cellules cellules en colonnes (C, D, H, I, J) si les cellules en colonne B sont renseignées ainsi que les photos qui seront elles placer dans le dossier "chine". Je lis beaucoup et regarde de nombreuses vidéos explicatives mais je suis totalement "larguer". Le langage VBA est encore hermétique (très nul en anglais) donc je ne comprend pas grand chose, je fais tout en tâtonnant et je test. C'est très fatiguant et frustrant de ne pas pouvoir avancer.

Je ne me décourage pas, je continu à avancer.

Merci pour la solution.

Bonne soirée

donc, la macro ne fonctionnait pas ?

Bonsoir,

Je viens de tester la macro, rien ne se passe dans mon fichier excel "japon" rien ne se passe, les images ne s'insèrent pas.

MESSAGE : LE FICHIER JPG N'EXISTE PAS.
Mon dossier image sur disque dur externe est complet. J'ai pu insérer toutes les images dans mon fichier excel.
La macro ne fonctionne donc pas. Je l'ai testé aussi dans mon fichier "Chine" c'est la même chose.
Je verrai plus tard
Merci malgré tout.
Bonne soirée

Bonsoir,

Non la macro d'extraction de données d'un site Web avec insertion dans des cellules données ne fonctionnement toujours pas. je recommence tout depuis le début dans mon fichier test.

Excellente soirée

une nouvelle première ligne pour vérifier si votre chemin dans "P:" existe ou est accessible.

donc ajouter ceci au début ou remplacer l'ancienne macro par celle-ci

 If Dir(sChemin, vbDirectory) = "" Then MsgBox "votre chemin n'existe pas", vbCritical, sChemin
Sub M_Japon()
     Dim s     As String, c

      If Dir(sChemin, vbDirectory) = "" Then MsgBox "votre chemin n'existe pas", vbCritical, sChemin

     For Each c In Sheets("Japon").Columns("B").SpecialCells(xlConstants)     'toutes les cellules avec contenu fix de la colonne B
          If c.Offset(, -1).Value <> "" And c.Value <> "" Then     'la cellule A&B ne sont pas vide
               If c.Comment Is Nothing And Not c.MergeCells Then     'cellule n'a pas encore un commentaire et n'est pas fusionnée
                    s = sChemin & IIf(Right(sChemin, 1) <> "\", "\", "") & c.Value2 & ".jpg"     'fullname de votre image
                    If Len(Dir(s)) = 0 Then  'vérifier si le fichier existe dans ce chemin
                         MsgBox s, vbCritical, "fichier n'existe pas"
                    Else
                         Application.Goto c  'choisir cette cellule comme "activecell"
                         MsgBox "Valeur : " & c.Value & vbLf & "on ajoutera un commentaire avec l'image " & vbLf & s, , "Cellule : " & c.Address
                         AddPictureInComment s     'lancer macro avec le nom de l'image comme paramètre
                    End If
               End If
          End If
     Next
End Sub

Bonsoir,

Je vous envoi le fichier car rien ne marche.

Vous aurez une vue générale et vous permettra peut-être de comprendre plus facilement ce que je désire au final.

Merci pour votre grande patience.

Bonne fin de soirée.

11chine-test.zip (488.18 Ko)

un nouveau essai, j'ai mis plusieurs Fuxi's à partir de B36, la macro ne traite que les cellules non-vides;non-fusionnées et sans commentaire.

5chine-test.zip (486.23 Ko)

Bonjour,

Je viens lors de ma pose de regarder votre solution.

Elle fonctionne, j'ai du modifier les images et les cellules (certains caractères accentués ne sont pas pris en charge) donc je les ai remplacés par caractères normaux et enlever l'en-tête de la colonne (Hànyǔ Pīnyīn).

J'ai toujours le problème sur les images (dimension), je ne comprends pas pourquoi. Est-il possible de lire la macro concernant le recalibrage. Erreur possible au niveau du code suivant :

If (WorksheetFunction.RoundDown(pic.Height, 0) < MaxHeight) And (WorksheetFunction.RoundDown(pic.Width, 0) < MaxWidth) Then
.Comment.Shape.Width = WorksheetFunction.RoundDown(pic.Width, 0)
.Comment.Shape.Height = WorksheetFunction.RoundDown(pic.Height, 0)
Else
If pic.Width > pic.Height Then
.Comment.Shape.Width = MaxWidth
.Comment.Shape.Height = WorksheetFunction.RoundDown(((pic.Height * .Comment.Shape.Width) / pic.Width), 0)
Else
Cells(ActiveCell.Row, ActiveCell.Column).Comment.Shape.Height = MaxHeight
Cells(ActiveCell.Row, ActiveCell.Column).Comment.Shape.Width = WorksheetFunction.RoundDown(((pic.Width * .Comment.Shape.Height) / pic.Height), 0)
End If
End If

Je souhaite des images toutes de même dimension et bien sur tienne compte des proportions de l'image originale pour que le fichier soit propre.

Je joins le fichier

6chine-test.zip (500.01 Ko)
4chine-test.zip (500.01 Ko)

Merci pour tout.

t'as le fichier (jpg) d'un image qui ne fonctionne pas bien ?

Bonsoir,

En effet, j'ai quelques images récalcitrantes dans le fichier CHINE mais aussi dans JAPON. J'essayerai d'y remédier plus tard car cet incident ne concerne qu'un tout petit nombre d'image.

Merci pour tous

Bonne soirée.

re,

tous les images auront une hauteur de 50 et une largeur variable.

7chine-test-1.zip (493.99 Ko)

Bonjour,

Je viens de regarder la solution proposée. Elle ne me convient pas car je souhaite que les images n'apparaissent qu'en survol du commentaire.

Je garde l'ancienne macro qui me convient mieux bien qu'un très petit nombre de photos pose un problème de taille.

Par contre le fichier "JAPON" est terminé sans souci important ce qui n'est pas le cas du fichier "CHINE". En effet, dans "JAPON", les lettres accentuées romaji sont prises en compte par la macro (nom image= orthographe identique que celle des cellules de la colonne B). Par contre dans "CHINE" les lettres accentuées Hànyǔ pīnyīn ne sont pas reconnues par la macro (comme dans "Japon", les images sont orthographiées par rapport cellules de la colonne B). Il en découle que tout les noms avec accent ne permettent pas d’insérer l'image en commentaire (message = Le fichier ".jpg" n'existe pas).

Le fichier complet "CHINE" contient plus de 500 entrées je ne me vois pas du tout faire toutes les manipulations manuelles dans ces circonstances. Perte de temps trop importante.

Je ne sais pas résoudre ce problème malgré mon obstination dans la recherche sur les forums et des vidéos. Maintenant, je suis complètement perdu.

Merci tout pour tout ce temps passer à résoudre mes problèmes. Si vous avez une suggestion pour remédier à ce souci, je vous en remercie par avance.

Bonne journée.

je souhaite que les images n'apparaissent qu'en survol du commentaire.

ce n'est qu'une ligne en VBA

6chine-test-1.zip (555.61 Ko)

pouvez-vous me donner un/quelques fichier(s) avec un nom avec des lettres accentuées romaji ? Quand je sauvegarde un image de wikipedia, c'est sans ces accents,donc je ne peux pas tester.

Autre question, vous avez Windows ou Mac ?

Bonjour,

Voici le fichier test ainsi qu'une photo.

Bonne journée.

4chine-test.xlsm (65.47 Ko)
n w

oei, désolé, je veux quelque fichiers d'images, donc des *.jpg,dont le "*" contient une ou plusieurs de vos "accents romaji" et ne pas des images dans le poste ...

,

Oups,

Désolé, je n'avais pas compris

Voici la rectification de mon erreur

Fúxī.jpg

Huángdì.jpg

Nǚwā.jpg

Zhuānxū.jpg

Yǔ ou Dàyǔ.jpg

Yáo ou Diyáo.jpg

Avec toutes mes excuses

Merci par avance pour tous vos efforts.

Bonne journée.

Rechercher des sujets similaires à "aide macro insertion image"