Bonjour à toutes et à tous,
J'ai besoin de vos conseils pour parvenir à redimensionner des images depuis Excel.
Les images sont stockées dans le même dossier que le fichier excel.
Elles font toutes 401 x 494
Je souhaiterais les redimensionner pour obtenir 40 x 49
Merci pour votre aide
___________
J'y suis parvenu avec la macro suivante :
	
	
	
	
	
		
	
		
			
		
		
	
				
			J'ai besoin de vos conseils pour parvenir à redimensionner des images depuis Excel.
Les images sont stockées dans le même dossier que le fichier excel.
Elles font toutes 401 x 494
Je souhaiterais les redimensionner pour obtenir 40 x 49
Merci pour votre aide
___________
J'y suis parvenu avec la macro suivante :
		Code:
	
	
	Sub stock()
ReDim NomFich(0)
Dim Nms As Name
Dim LeGraph As Object
Dim Fich As String
Application.ScreenUpdating = False
N = 1
For Each sh In Sheets
  ActiveWorkbook.Names.Add Name:="Fiche" & N, RefersToR1C1:="=" & sh.Name & "!R1C1:R29C5"
  NomFich(UBound(NomFich)) = "Fiche" & N
  ReDim Preserve NomFich(UBound(NomFich) + 1)
  N = N + 1
Next
 ReDim Preserve NomFich(UBound(NomFich) + 1)
For Each Nms In Names
    If Left(Nms.Name, 5) = "Fiche" Then
        Range(Nms.Name).CopyPicture
        'MsgBox (Range(Nms.Name).Width & " " & Range(Nms.Name).Height) 
        'permet de connaître la taille initiale de la copie écran qu'ensuite on pourra réduire à la dimension souhaitée
        Set LeGraph = ActiveSheet.ChartObjects.Add(0, 0, Range(Nms.Name).Width - 270, Range(Nms.Name).Height - 330.75)
        LeGraph.Chart.Paste
        Fich = ActiveWorkbook.Path & "\" & Nms.Name & ".gif"
        LeGraph.Chart.Export Filename:=Fich, FilterName:="GIF"
        LeGraph.Delete
    End If
Next Nms
End Sub
[/cod]
	
			
				Dernière édition: