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 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56
|
Sub InsertionImagesSelonRepertoire()
'Macro qui permet une insertion d'une série d'images d'un répertoire donné,
'Avec une ligne blanche entre chaque image
Dim lesfichiers() As String
Dim Repertoire As String
Dim Extension As String
Dim Fichier As String
Dim limage As String
Dim i As Integer
Dim positiongauche As Single
Dim positionhaut As Single
Dim decalagedroite As Single
Dim decalageBas As Single
'On peut modifier les valeurs des constantes
'pour modifier les résultats obtenus
Const CombienParLigne = 6
Const debutgauche = 100
Const debuthaut = 20
Const espacedroite = 10
Const espacebas = 10
Const largeurimage = 200
Const HauteurImage = 200
'emplacement de la première image
positiongauche = debutgauche
positionhaut = debuthaut
decalagedroite = largeurimage + espacedroite
decalageBas = HauteurImage + espacebas
'Saisie du nom du répertoire
Repertoire = InputBox("Chemin complet du répertoire (\ à la fin)", "Répertoire", "C:\Temp\Images\")
'Saisie du type d'extension
Extension = InputBox("Type de fichier (sans le point, ex : jpg, png, bmp)", "Type de fichier", "jpg")
i = 1
'Récupération du premier fichier du répertoire
Fichier = Dir(Repertoire & "*" & Extension, vbDirectory)
Do While Fichier <> ""
If i > CombienParLigne Then
'Position de la ligne suivante
'et retour à la gauche de l'écran
positionhaut = positionhaut + decalageBas
positiongauche = debutgauche
i = 1
End If
limage = Repertoire & Fichier
Set mafeuille = Worksheets("Modifiée")
mafeuille.Shapes.AddPicture limage, True, True, _
positiongauche, positionhaut, largeurimage, HauteurImage
'emplacement de la prochaine image
positiongauche = positiongauche + decalagedroite
i = i + 1
Fichier = Dir
Loop
'sauvegarde de l'oeuvre.
ThisWorkbook.Save
End Sub |
Partager