Dosya Ebatı

[bassgitarist]

Arkadaşlar sorunum şu, excel dosyalarım var ve bunların içerisine büyük ebatlı resimler yüklemişler ve bi excel dosyam neredeyse 70MB a kadar yükselmiş, bu resimleride silemiyorum bana lazım ama dosya sayım çok resimleri değiştemiyorum sorum şu ki bu dosyaların ebatlarını resimleri tekrar küçültüp eklemek dışında küçültebileceğim bi yöntem war mı?

 

[Orion1]

Aşağıdaki kodu çalıştırrak aktif sayfadaki resimlerin tamammının boyutlarını değiştirebilirsiniz.İnputbox'lara yükseklik ve genişlikleri girmeniz yeterli.

Sub resim_boyutlari()
yukseklik = InputBox("Resmin Yüksekliğini Giriniz..:", "RESİM")
genislik = InputBox("Resmin Genişliğini Giriniz..:", "RESİM")
If yukseklik = "" Or genislik = "" Then
    MsgBox "Yükseklik veya Genişlik Boş olamaz..!!", vbCritical, "DİKKAT"
    Exit Sub
End If
For i = 1 To ActiveSheet.Shapes.Count
    If Left(ActiveSheet.Shapes(i).Name, 7) = "Picture" Then
        ActiveSheet.Shapes(i).LockAspectRatio = msoFalse
        ActiveSheet.Shapes(i).Height = yukseklik
        ActiveSheet.Shapes(i).Width = genislik
        ActiveSheet.Shapes(i).Rotation = 0#
    End If
Next i
End Sub