Compress Pictures with VBA
Hi NickHK,
I start the record and selectcs one picture and he should do this for
every picture in the document, here is my complete code:
Sub bildEinfuegen()
Dim bild As Variant
Dim pfad As String
Dim i As Integer
Dim name As String
Dim orgHoehe As Double
Dim orgBreite As Double
Dim neueBreite As Double
Dim spalte As Integer
neueBreite = 10 'in cm
neueBreite = Application.CentimetersToPoints(neueBreite)
spalte = 1
pfad = "D:\Austausch\"
For i = 1 To 3
name = "DB2 V7_" & i & ".jpg"
bild = pfad & name
Cells(1, spalte).Select
ActiveSheet.Pictures.Insert(bild).Select
orgHoehe = Selection.ShapeRange.Height
orgBreite = Selection.ShapeRange.Width
Selection.ShapeRange.Width = neueBreite
Selection.ShapeRange.Height = orgHoehe * neueBreite / orgHoehe
.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#
spalte = spalte + 3
Next i
End Sub
we are using Excel 2003
NickHK schrieb:
Micha,
I have just changed to using XL2002. Recording a macro of compressing a
resized graphic gives output that contained nothing part from
ActiveSheet.Shapes("Picture 2").Select
So I'm not sure at the moment.
However, do you have a Picture selected before running the code, as you are
working the Selection object.
NickHK
"Micha" wrote in message
ps.com...
Hi everbody,
I tried to compress pictures with a makro. If I do manually, format
graphic -- compress -- web/monitor 96 dpi, it works, but when I
record this with the makro recorder and play it, it doesen't work.
Here is the code which I record:
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#
So can anybody help me, how I can compress an image with VBA???
Thanks for your answers??
Micha
|