1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41
|
Sub InsertionImages()
'Macro qui permet une insertion d'une série d'images d'un répertoire donné,
'Avec une ligne blanche entre chaque image
Dim Repertoire As String
Dim Extension As String
Dim Fichier As String
'Saisie du nom du répertoire
Repertoire = InputBox("Chemin complet du répertoire (\ à la fin)", "Répertoire", "D:\Mes images")
'Saisie du type d'extension
Extension = InputBox("Type de fichier (sans le point, ex : jpg, png, bmp)", "Type de fichier", "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
Set objShape = Selection.InlineShapes.AddPicture(FileName:=Repertoire & Fichier)
With objShape
.LockAspectRatio = msoTrue
If .Width > .Height Then
.Width = 400
Else
.Height = 300
End If
End With
'Insertion d'une ligne vide
Selection.TypeParagraph
Selection.TypeText Text:="PHOTOGRAPHIE N°"
'Insertion d'une ligne vide
Selection.TypeParagraph
'Récupération du prochain fichier du répertoire
Fichier = Dir
Loop
End Sub |
Partager