Excelde yazılan makroda resim boyutunun aşırı büyümesi

[Hido.Fethiye]

merhabalar,
aşağıda yazılan makro ile excelde bir hücre içerisine resim atılmaktadır. Bu makro uygulandığında mevcutta 4 mb boyutundaki resim excelde 70-80 mb olmaktadır. Resim boyutunun küçültülmesi için neler yapılabilir?




Private Sub Image1_Click()
Dim fichImg
fichImg = Application.GetOpenFilename("Fichier image(*.gif;*.jpg;*.bmp),*.gif;*.jpg;*.bmp" _
, , "Choix de l'image.1", , False)
'false selection simple
'If fichImg = False Then Exit Sub
'ActiveSheet.Pictures.Insert(fichImg).Select
On Error Resume Next
Sheets(ActiveSheet.Name).Image1.Picture = LoadPicture(fichImg)
Dim ImgBak As Range
Dim ImgYol As String

Image1.PictureSizeMode = fmPictureSizeModeZoom
Image1.PictureSizeMode = fmPictureSizeModeStretch


ImgYol = ThisWorkbook.Path & "\"
With Range("N1")
Set ImgBak = .Find(Range("N1").Value)
On Error Resume Next
If ImgBak Is Nothing Then
Image1.Picture = LoadPicture(ImgYol & "4071.jpg")
Else
With ImgVar
On Error Resume Next
Image1.Picture = LoadPicture(ImgYol & Range("N2").Value & ".jpg")
If Err = 0 Then Exit Sub
Image1.Picture = LoadPicture(ImgYol & "4071.jpg")
End With
End If
End With
Set ImgBak = Nothing
End Sub

 

[Emir Hüseyin Çoban]

. . .

Deneme yapabilmek için resim ve tablodan örnek yükleyiniz.

. . .

 

[Hido.Fethiye]

. . .

Deneme yapabilmek için resim ve tablodan örnek yükleyiniz.

. . .

Ekte yer almaktadır.

Bu makro ile resim secildiğinde excel dosyasının boyutu aşırı büyümektedir. Mesela normalde 4 mb'lık bir resim eklendiğinde excel dosyası yaklaşık 90 Mb olmaktadır.

 

[Emir Hüseyin Çoban]

. . .

Örnek dosyada kodlarınız yok. Yüklenecek resim yok...

. . .