Redimentionner une photo via VBA

Re : Redimentionner une photo via VBA

Salut,
J'ai un nouveau problème avec cette macro.
Il va bien chercher toutes les photos dans le répertoire ciblé et il les insère correctement redimensionnées dans Excel.
Mais ... il les prend dans l'ordre alphabétique inverse.
J'imagine que c'est plus dans Windows que dans Excel qu'il faut corriger, mais je vois pas du tout.
Est-il possible de préciser dans la macro qu'il prenne les photo dans l'ordre alphabétique ?
Merci d'avance et bonne soirée.

Fab

Re : Redimentionner une photo via VBA

Bonsoir,

Je suppose qu'il affiche les fichiers l'ordre dans lequel ils sont affichés par l'explorateur windows et les paramètres d'affichage du dossier. A vérifier.

Sinon, il faudrait réécrire la macro.
Mettre les noms dans un tableau à 1 dimension, le trier et appeler les fichiers 1 à 1 à partir de ce tableau.

A+

Re : Redimentionner une photo via VBA

Salut,
Merci pour ton suivi.
J'ai fait une multitude d'essais dans Windows, mais je ne comprend pas la logique d'Excel dans l'insertion des photos => j'ai tout retravaillé.
1) il compte le nombre de photo dans le répertoire cible
NombreDeLigneAInserer = fol.Files.Count
2) Il rajoute les lignes manquantes
3) Il inscrit les noms des fichiers dans chaque cellule
For Each fil In fol.Files
Cells(LigneOuCollerLaPhoto, 1).Select
Cells(LigneOuCollerLaPhoto, 1) = fil.Name
LigneOuCollerLaPhoto = LigneOuCollerLaPhoto + 3
Next
4) Il reclasse par ordre alphabétique
Range("A7:B" & (NombreDeLigneAInserer * 3) + 7).Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
5) Dans chaque cellule il récupère le nom inscrit et va chercher la photo correspondant (puis il la redimentionne)

Tout va bien jusqu'au point 5 où il selectionne bien la bonne cellule, récupère bien le bon nom, va bien chercher la bonne photo, mais ... il l'insère dans la mauvaise cellule. En fait, il les insère toute en "A7".

Voici le code de cette partie :
LigneOuCollerLaPhoto = 7
For i = 1 To NombreDeLigneAInserer
Range("A" & LigneOuCollerLaPhoto).Select
NomDeLaPhoto = Cells(LigneOuCollerLaPhoto, 1)
Set oImage = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\TmpPhotosMiniatures\" & NomDeLaPhoto)
With oImage
With .ShapeRange
.LockAspectRatio = msoTrue
.Top = Range("A7").Top
.Left = Range("A7").Left
If .Width > Range("A7").Resize(3, 2).Width Then .Width = Range("A7").Resize(3, 2).Width
If .Height > Range("A7").Resize(3, 2).Height Then .Height = Range("A7").Resize(3, 2).Height
End With
End With
LigneOuCollerLaPhoto = LigneOuCollerLaPhoto + 3
Next i

Sais-tu pourquoi il ne veut pas faire l'insertion en Range("A" & LigneOuCollerLaPhoto) ?

Merci d'avance.

Fab

Re : Redimentionner une photo via VBA

Mais c'est bien sur.
Avec :
.Top = Range("A" & LigneOuCollerLaPhoto).Top
.Left = Range("A" & LigneOuCollerLaPhoto).Left
If .Width > Range("A" & LigneOuCollerLaPhoto).Resize(3, 2).Width Then .Width = Range("A" & LigneOuCollerLaPhoto).Resize(3, 2).Width
If .Height > Range("A" & LigneOuCollerLaPhoto).Resize(3, 2).Height Then .Height = Range("A" & LigneOuCollerLaPhoto).Resize(3, 2).Height

Ca va tout de suite mieux.

Merci encore et bon week-end