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
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?
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
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
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
- Messages postés
-
13863
- Date d'inscription
- lundi 9 juin 2008
- Statut
- Contributeur
- Dernière intervention
- 12 janvier 2021
780 > KublaikhanFichier = Dir("")merci d'utiliser les balises de code, sachant que VBA, c'est du basic: https://codes-sources.commentcamarche.net/faq/11288-les-balises-de-code