Insertion automatique de photos dans un tableau Word

Résolu
Kublaikhan -  
 Ladybud -
Bonjour,

En vous souhaitant une belle année 2021 plus positive que 2020, j'aimerais vous soumettre la question suivante :
J'ai des photos que j'aimerais insérer automatiquement dans un tableau dans Word, c'est-à-dire qu'elles s'insèrent chacune dans une cellule différente de la même colonne.
Je fonctionne avec Windows 10 et Word 365.

Je suis totalement débutant en macros, mais en regardant un peu j'ai tenté ce qui suit avec des copier-collés. La macro fonctionne, mais une seule fois : elle insère une seule image. Et si je la relance, elle insère la même image une seule fois, même si je sélectionne plusieurs cellules.

Pouvez-vous m'aider pour qu'elle insère toutes les images de mon répertoire, les unes après les autres?

Merci beaucoup.

Sub InsImg ()
'
' InsImg Macro

Dim Repertoire As String
Dim Extension As String
Dim Fichier As String
 
'Saisie du nom du répertoire
Repertoire = "C:\Users\Images\"
'Saisie du type d'extension
Extension = "jpg"
 
'Récupération du premier fichier du répertoire
Fichier = Dir(Repertoire & "*" & Extension, vbDirectory)
 
Do While Fichier <> ""
    i = i + 1
    'Insertion de l'image
    Selection.InlineShapes.AddPicture FileName:=Repertoire & Fichier
    'Insertion d'une ligne vide
    Selection.TypeParagraph
    'Récupération du prochain fichier du répertoire
    Fichier = Dir
Loop
End Sub

EDIT : Ajout du LANGAGE dans les balises de code (la coloration syntaxique).
Explications disponibles ici :
https://codes-sources.commentcamarche.net/faq/10686-le-nouveau-codes-sources-comment-ca-marche#balises-code

Merci d'y penser dans tes prochains messages.

Configuration: Windows / Chrome 87.0.4280.88

2 réponses

  1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 588
     
    bonjour,
    je me demande si ton code se déplace correctement dans le tableau.
    as-tu essayé avec l'enregistreur de macro, par exemple en tapant une lettre dans chaque ligne du tableau?
    0
    1. Kublaikhan
       
      Bonjour,
      J'ai modifié la fin du code pour descendre automatiquement d'une ligne. Effectivement, le code ne se déplaçait pas après avoir inséré une image.
      Donc maintenant la macro va chercher une photo dans le répertoire, la place dans la cellule, descend à la cellule en dessous et puis s'arrête. Comment faire pour qu'elle continue avec les images suivantes?
      Une idée pour les dernières lignes du code?
      Merci!

      Sub InsImg ()
      '
      ' InsImg Macro

      Dim Repertoire As String
      Dim Extension As String
      Dim Fichier As String

      'Saisie du nom du répertoire
      Repertoire = "C:\Users\Images\"
      'Saisie du type d'extension
      Extension = "jpg"

      'Récupération du premier fichier du répertoire
      Fichier = Dir(Repertoire & "*" & Extension, vbDirectory)

      Do While Fichier <> ""
      i = i + 1
      'Insertion de l'image
      Selection.InlineShapes.AddPicture FileName:=Repertoire & Fichier
      'Descendre d'une cellule
      Selection.MoveDown Unit:=wdLine, Count:=1
      'Récupération du prochain fichier du répertoire
      Fichier = Répertoire
      Loop
      End Sub
      0
  2. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Bonjour,

    voir ceci:

    https://www.faqword.com/index.php/generalites-office-2/959-comment-inserer-des-images-avec-une-taille-imposee

    a mettre dans un module

    Option Explicit
    'https://www.faqword.com/index.php/generalites-office-2/959-comment-inserer-des-images-avec-une-taille-imposee
    Sub InsImg()
    '
    ' InsImg Macro
    
    Dim Repertoire As String
    Dim Extension As String
    Dim Fichier As String
    Dim image As Object
    'Saisie du nom du répertoire
    Repertoire = "C:\Users\Images\" 'mettre le chemin du dossier image
    'Saisie du type d'extension
    Extension = "jpg"
     
    'Récupération du premier fichier du répertoire
    Fichier = Dir(Repertoire & "*" & Extension, vbDirectory)
     
    Do While Fichier <> ""
        'Insertion de l'image
        'Selection.InlineShapes.AddPicture FileName:=Repertoire & Fichier
        Set image = Selection.InlineShapes.AddPicture(Repertoire & Fichier)
    With image
        .LockAspectRatio = msoTrue
        '.Height = CentimetersToPoints(xx)
        .Width = CentimetersToPoints(5)
    End With
        'Insertion d'une ligne vide
        Selection.TypeParagraph
        'Récupération du prochain fichier du répertoire
        Fichier = Dir
    Loop
    End Sub
     Sub SupprimerImages()
    Dim image As InlineShape
    ' supprime tous les images
    For Each image In ActiveDocument.InlineShapes
    image.Delete
    Next
    End Sub
    Sub centrage_photos()
    Dim n As Integer, x As Integer
    n = Application.ActiveDocument.InlineShapes.Count
        For x = 1 To n
          ActiveDocument.InlineShapes(x).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
        Next
    If n <> 0 Then MsgBox n & " photos centrées" Else MsgBox "Aucune photo n'a été centrée"
    End Sub
    


    voilà
    0
    1. Kublaikhan
       
      ça marche! Magnifique. Et en plus elles se redimensionnent.
      Merci beaucoup. :-)
      Meilleurs voeux!
      0
    2. Ladybud
       
      Bonjour,

      Je reviens sur ce post car j'essaie d'utiliser la macro mais elle ne fonctionne pas. Je n'y connais pas grand chose en code juste les rudiments. J'ai changé le chemin de l'image et le type d'extension ainsi que le nom de la première image. Pourriez-vous m'indiquer quels autres changements je dois effectuer afin que cette macro fonctionne svp ?
      Merci beaucoup d'avance !
      0