macro de récupération d'image dans un ous-dossier sur un code clé

stephsteph

XLDnaute Occasionnel
Bonjour,

Comme Modeste l'a suggéré dans le fil perécédent (https://www.excel-downloads.com/threads/souci-macro-vba-word-2000-sur-2007.220248/) j'ouvre un nouveau fil pour cette question experte.

Donc voici la question (pour un champion comme on dit à la télé), serait il possible d'avoir une macro qui reconnaitrait un code entre 2 caractères (par exemple entre ££, mais pas $$ cette fois) qui permettrait d'aller chercher dans un sous-dossier une jpg avec un nom de fichier identique au code entre les 2 caractères précédents et de l'insérer à la place de ce code.

J'ai ci-dessus simplifié le message précédent car cela ne me parait pas indispensable de passer par un 2ème fichier illustrations.docm

Prenons un exemple simple (j'attache le fichier en zip de testfruit1.docm)... j'ai mis en rouge quelques exemples.
La macro trouverait les occurrences entre 2 (par exemple £blabla$5£) et irait chercher la jpg appelée blabla$5.jpg dans le sous-dossier pour l'afficher dans le doc Word à la place de l'occurrence entre les 2 caractères '£'. Il faudra (facile) aussi formater la photo (centrée) et non intégrée au texte (marque de paragraphe avant et après la photo).

Merci à Modeste et aux autres experts du forum

Steph
 

Pièces jointes

  • Testfruits1.zip
    25.9 KB · Affichages: 81
  • Testfruits1.zip
    25.9 KB · Affichages: 83
  • Testfruits1.zip
    25.9 KB · Affichages: 80

mromain

XLDnaute Barbatruc
Re : macro de récupération d'image dans un ous-dossier sur un code clé

Bonsoir Steph, Modeste, le forum :)

Ci-joint un fichier zip contenant ton document avec la macro et un dossier contenant les images à insérer. Pour tester, déziper le tout, ouvrir le document word et exécuter la macro.

La première partie du code est une fonction qui permet de faire des recherches dans un Range et renvoie toutes les occurrences (Range) trouvées.
VB:
Private Function LaunchSearch(rng As Range, txt As String, matchWildCar As Boolean) As Range()
Dim recherche As Find, docParent As Object, rngRes() As Range, iRes As Long
   
    Set docParent = rng
    While TypeName(docParent) <> "Document"
        Set docParent = docParent.Parent
    Wend

    Set recherche = rng.Find
    With recherche
        .MatchWildcards = matchWildCar
        .Text = txt
        iRes = 0
        ReDim rngRes(1 To 1)
        Set rngRes(1) = Nothing
        While .Execute = True
            iRes = iRes + 1
            ReDim Preserve rngRes(1 To iRes)
            Set rngRes(iRes) = docParent.Range(.Parent.Start, .Parent.End)
        Wend
    End With
    LaunchSearch = rngRes
End Function

Ensuite, la macro à proprement parler est la suivante :
VB:
Sub Test()
Dim i As Long, res() As Range, pathJpg As String, myFso As Object, img As InlineShape
    
    'lancer la recherche des textes entre '£'
     res = LaunchSearch(ActiveDocument.Range, "£*£", True)
    Set myFso = CreateObject("Scripting.FileSystemObject")
    
    'boucler sur les résultats
     For i = LBound(res) To UBound(res)
        
        If res(LBound(res)) Is Nothing Then Stop    'si arrêt, on n'a rien trouvé dans le document
        
        'créer le path de l'image à insérer et contrôler si elle existe
         pathJpg = ActiveDocument.Path & "\images\" & Replace(res(i).Text, "£", "") & ".jpg"
        If Not myFso.FileExists(pathJpg) Then Stop      'si arrêt, l'image n'a pas été trouvée
        
        res(i).Text = vbNullString          'supprimer le texte entre les '£'
         res(i).InsertParagraphBefore        'insérer des paragraphes avant et après
         res(i).Next.InsertParagraphAfter
        res(i).Next.ParagraphFormat.Alignment = wdAlignParagraphCenter      'centrer
         Set img = res(i).Next.InlineShapes.AddPicture(pathJpg, False, True) 'ajouter l'image
     Next i

End Sub

A+
 

Pièces jointes

  • Testfruits1.zip
    75.2 KB · Affichages: 91
  • Testfruits1.zip
    75.2 KB · Affichages: 94
  • Testfruits1.zip
    75.2 KB · Affichages: 99

stephsteph

XLDnaute Occasionnel
Re : macro de récupération d'image dans un ous-dossier sur un code clé

Bonjour mromain,

J'ai tardé à réagir et tu vas comprendre pourquoi.
Mais tout d'abord merci pour ce code vraiment expert!
Le code est très propre et tu as même ajouté des images qui correspondent aux fruits figurés... superbonus.

Et bien sûr, cela marche super nickel...
à 100% sur le fichier zipé...
à 99.9% sur mon fichier réel.

J'ai mis beaucoup de temps à comprendre pourquoi.
Sur mon fichier la macro bugge immédiatement et surligne en jaune
Is Nothing Then Stop

Cela vient du fait que mon fichier a quelques particularités ici et là :
Certaines images se suivent sans texte intercalaire.
Alors mes £xxx£ et £yyy£ sont séparés par une marque de paragraphe (« pi »).
Mais j’ai aussi essayé avec seulement un espace entre £xxx£ et £yyy£ (ce qui permettrait d’accoler les 2 images centrées), mais cela bugge aussi.

Bien sûr je peux bidouiller en ajoutant un texte toujours le même entre £xxx£ et £yyy£, puis, après la macro, je le supprimerai…
Qu’en penses-tu ?

En tous cas encore merci et… chapeaux bas !

A+, Steph
 

mromain

XLDnaute Barbatruc
Re : macro de récupération d'image dans un ous-dossier sur un code clé

Bonsoir Steph, le forum :)

Je pense qu’il va falloir que tu mettes un fichier exemple représentant les 0,1% posant problème. Je t’avoue ne pas avoir compris le problème...
Le code ci-dessus utilise la fonction de recherche de Word avec les caractères génériques (matchWildCar dans le paramètre de la fonction de recherche). Donc si tu arrives à trouver une chaîne de recherche qui trouve les résultats escomptés depuis la fonction de recherche Word, ce sera facilement adaptable au code VBA.
Par contre, merci pour la remarque suivante :
... tu as même ajouté des images qui correspondent aux fruits figurés...
et si jamais tu renvoies un problème, merci de faire de même, et préparer un contexte complet :)

A+ et bonne soirée
 

stephsteph

XLDnaute Occasionnel
Re : macro de récupération d'image dans un ous-dossier sur un code clé

Bonjour mromain,

C’est difficile d’expliquer clairement (tu cites Einstein, tu pourrais ajouter « tout ce qui se conçoit bien s'énonce clairement et les mots pour le dire arrivent aisément » de Boileau)!
Il faut que je prenne le réflexe d’ajouter un fichier attaché.
Modeste me l’avait déjà dit (il doit se moquer !)
Ci-joint le nouveau fichier en zip dans lequel j’ai accolé 2 £xxx£ et £yyy£.
Bug.
Tu peux aussi essayer, par exemple à la fin, d’ajouter un « pi » (paragraphe) après la dernière image, puis une autre image tout de suite après.
C’est OK jusqu’à l’image avant le « pi » puis bug !
Teste tu vas voir !
A+ (et encore merci, c’est un minuscule souci).
Steph
 

Pièces jointes

  • Testfruits13.zip
    27.6 KB · Affichages: 86

mromain

XLDnaute Barbatruc
Re : macro de récupération d'image dans un ous-dossier sur un code clé

Bonjour Steph, le forum :)

Voici le code modifié, qui semble ne pas bugger sur l'exemple fourni :
VB:
Sub Test()
Dim i As Long, res() As Range, pathJpg As String, myFso As Object, img As InlineShape
    
    'lancer la recherche des textes entre '£'
     res = LaunchSearch(ActiveDocument.Range, "£*£", True)
    Set myFso = CreateObject("Scripting.FileSystemObject")
    
    If res(LBound(res)) Is Nothing Then Stop    'si arrêt, on n'a rien trouvé dans le document
    
    'boucler sur les résultats
     For i = UBound(res) To LBound(res) Step -1
        
        'créer le path de l'image à insérer et contrôler si elle existe
         pathJpg = ActiveDocument.Path & "\images\" & Replace(res(i).Text, "£", "") & ".jpg"
        If Not myFso.FileExists(pathJpg) Then Stop      'si arrêt, l'image n'a pas été trouvée
        
        res(i).Text = vbNullString          'supprimer le texte entre les '£'
         res(i).InsertParagraphAfter        'insérer des paragraphes avant et après
         res(i).InsertParagraphAfter
        res(i).Paragraphs(2).Alignment = wdAlignParagraphCenter      'centrer
         Set img = res(i).Paragraphs(2).Range.InlineShapes.AddPicture(pathJpg, False, True) 'ajouter l'image
     Next i

End Sub
A+
 

stephsteph

XLDnaute Occasionnel
Re : macro de récupération d'image dans un ous-dossier sur un code clé

Bonjour mromain
Merci, c'est tout à fait OK!
Puis-je te poser une question de compréhension (et de futur).
Si je veux garder les 2 images acollées (pas séparées par un pi ou br), comment je fais?
J'ai essayé de désactiver une par une les 3 lignes suivantes mais ce n'est pas bon:
Code:
        res(i).InsertParagraphAfter        'insérer des paragraphes avant et après
        res(i).InsertParagraphAfter
res(i).Paragraphs(2).Alignment = wdAlignParagraphCenter
Pourquoi répètes-tu 2 fois after dans res(i).InsertParagraphAfter ?
Y-a-t'il pas un "before"?
Et puis si je veux déterminer la taille de mes images par rapport à l'original (en % ou mieux en largeur, pour les faire de la même largeur si les originaux ne le sont pas ?

Bon ce sont des fioritures...

En tout cas tu es super !
A+
Steph
 

mromain

XLDnaute Barbatruc
Re : macro de récupération d'image dans un ous-dossier sur un code clé

Bonjour Steph, le forum :)

Si je veux garder les 2 images acollées (pas séparées par un pi ou br), comment je fais?
J'avais cru comprendre que c'était ce que tu voulais...
J'ai essayé de bidouiller (j'y vais à taton), mais j'ai pas réussi.

Pourquoi répètes-tu 2 fois after dans res(i).InsertParagraphAfter ?
De ce que j'ai compris, mais je suis loin d'être sûr, InsertParagraphAfter insère un paragraphe dans la Range et le After signifie de l'ajouter à la fin.
Après les deux InsertParagraphAfter, la Range possède donc trois paragraphes, et on insère l'image dans le second.

Et puis si je veux déterminer la taille de mes images par rapport à l'original (en % ou mieux en largeur, pour les faire de la même largeur si les originaux ne le sont pas ?
Une fois l'image insérée, tu peux définir une largeur fixe pour l'image avec img.Ce lien n'existe plus ou proportionnelle à la taille d'origine avec img.Ce lien n'existe plus.
Pareil pour la hauteur avec img.Ce lien n'existe plus et img.Ce lien n'existe plus.

A+
 

stephsteph

XLDnaute Occasionnel
Re : macro de récupération d'image dans un ous-dossier sur un code clé

Bonjour mromain,

Merci de ces commentaires (ton tatonnement est 1000 fois plus performant que le mien!!!).
Tu as raison, c'est bien comme cela que j'ai commencé (séparation par "pi").
Mais avec 2 images à la suite, je me suis dit...
Ton explication de la macro est claire et donc c'est inutile d'en faire une autre pour la cas particulier de 2 images qui se suivent.
D'autant que je pourrais bricoler qqch.
En effet après la macro et l'affichage des 2 images elles sont séparées par "pi"espace"pi" et donc je devrais pouvoir manuellement les supprimer).
Pour être côté "sûr", j'aimerais pouvoir introduire un signe qui éviterait que des occurences imprévues soient traitées dans le texte inutilement.
Comme par exemple : "pi"espace§"pi" ou bien "pi"§espace"pi", est-ce possible d'ajouter ce caractère § dans une des instructions res(i).InsertParagraphAfter
Une autre condition pour que les 2 images soient accolées horizontalement est que l'image ne dépasse pas 7 cm.
Avec img.Width et une recherche internet conseillant d'utiliser InlineShapes j'ai essayé de modifier (car la création, par macro automatique, de taille ne semble pas marcher, en tout cas j'ai pas trouvé)
Set img = res(i).Paragraphs(2).Range.InlineShapes.AddPicture(pathJpg, False, True)
en:
Set img = res(i).Paragraphs(2).Range.InlineShapes.AddPicture(pathJpg, False, True).width = 70
ou
Set img = res(i).Paragraphs(2).Range.InlineShapes.width = 70.AddPicture(pathJpg, False, True)

Mais la macro bugge.
Cela doit être facile !

A+
Merci, Steph
PS: pour l'anecdote, j'ai essayé de changer le premier
res(i).InsertParagraphAfter
par
res(i).InsertParagraphBefore
Et c'est toujours OK.
 

stephsteph

XLDnaute Occasionnel
Re : macro de récupération d'image dans un ous-dossier sur un code clé

Bonjour le forum, bonjour mromain,

Sans réaction de mromain (qui a déjà largement contribué!) j'ai cherché un moyen de contourner ce léger problème de pi-espace-pi précédemment décrit.
Et j'ai ajouté un caractère spécial dans mon fihier txt (généré par des macros sur Excel).
La question de la width, eh bien tant pis je le ferai manuellement.

Encore merci à mromain (et assi à Staple1600 et Modeste pour l'autre question associée sans qui celle-ci n'aurait pas été posée).

Je considère l'affaire comme réglée (et le fil résolu).

Un bien beau forum d'entraide.
Merci 1000 fois.

Steph
 

Discussions similaires

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
314 628
Messages
2 111 337
Membres
111 104
dernier inscrit
JEMADA