compression automatique d'image dans excel - VB/VBA/VBS - Programmation
Marsh Posté le 08-11-2005 à 16:25:53
petite info que j'ai oublié:
le but de la macro est d'automatiser la fonction que propose déjà excel
dans excel sur une image il faut faire format de l'image puis compresser puis choisir toutes les images et format web.
voilà
Marsh Posté le 15-11-2005 à 15:09:28
Il semblerait qu'il ne soit pas possible d'utiliser la fonction compress de facon programmatique ...
Marsh Posté le 16-11-2005 à 12:21:20
Je n'en sais rien ... tout ce que j'ai lu comme moyen de contourner le problème est d'utiliser un macro pour appeler la fenêtre du compress ... c'est pas le pied ...
Marsh Posté le 18-11-2005 à 15:43:00
Bonjour vobiscum
est-ce que tu as toujours sous le coude la macro qui permet de contourner le problème en appelant la fenêtre du compress
@+
Marsh Posté le 18-11-2005 à 20:48:41
beberf1 a écrit : Bonjour vobiscum |
En fait, j'ai inséré une image via la fonction du menu "insertion->image->à partir du fichier" puis j'ai affecté une macro à l'image lorsque l'on clique dessus:
Code :
|
la macro ouvre la fenêtre de dialogue du "compress" ...
Si ca peut t'être utile
Marsh Posté le 08-11-2005 à 16:08:18
Voici le code, la partie qui me pose un problème se trouve vers la fin (en rouge)
Ma photo est inséré dans excel, redimentionné mais pas compressé
Sub photo_input()
On Error Resume Next
x = ActiveCell.Column
y = ActiveCell.Row
If y >= 1 And x >= 1 Then
choixphoto = Application.GetOpenFilename("Picture (*.jpg), *.jpg" )
pos1 = 1
For i = 1 To 100
posx = pos1 + 1
pos1 = InStr(pos1 + 1, choixphoto, "\" )
If pos1 = 0 Then Exit For
Next i
np = LCase(Mid(choixphoto, posx, 20))
ActiveSheet.Range("AR1" ).Value = np
ActiveCell.Value = Image & ": " & np
ActiveSheet.Pictures.Insert(choixphoto).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
'hauteur de l'image
Selection.ShapeRange.Width = 305
x = Selection.ShapeRange.Height
Selection.ShapeRange.Name = np
'Décalage avec le haut de la cellule
Selection.ShapeRange.IncrementTop
'Décalage avec la gauche de la cellule
Selection.ShapeRange.IncrementLeft
'Sélectionne la colonne de la cellule active
ActiveCell.EntireColumn.Select
'Définit la largeur de la colonne à 12.2
Selection.ColumnWidth = 60
'Sélectionne la ligne
Rows(y & ":" & y).Select
'Définit la hauteur de la ligne à 13
Selection.RowHeight = 235
'remet le curseur dans la colonne A ligne Y
' Range("A" & y).Select
'compression des photos
Selection.ShapeRange.PictureFormat.Brightness = 0.5
Selection.ShapeRange.PictureFormat.Contrast = 0.5
Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic
Selection.ShapeRange.PictureFormat.CropLeft = 0#
Selection.ShapeRange.PictureFormat.CropRight = 0#
Selection.ShapeRange.PictureFormat.CropTop = 0#
Selection.ShapeRange.PictureFormat.CropBottom = 0#
End If
End Sub
Message édité par beberf1 le 22-11-2005 à 10:17:14