- Katılım
- 30 Haziran 2005
- Mesajlar
- 157
60-70 sayfa civarında word sayfam var. bunlarda resimler var. sayfaları küçültmek istiyorum. sayfalardaki resimleri teker teker uğraşmadan, hepsini aynı anda boyutlarını ayarlayabilir miyim
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Merhaba,60-70 sayfa civarında word sayfam var. bunlarda resimler var. sayfaları küçültmek istiyorum. sayfalardaki resimleri teker teker uğraşmadan, hepsini aynı anda boyutlarını ayarlayabilir miyim
Sub Makro1()
oran = InputBox("Resimler hangi oranda küçültülsün?", "Resim Küçültme", 10)
If oran = "" Then Exit Sub
If oran < 0 Or oran >= 100 Or IsNumeric(oran) = False Then
MsgBox "Lütfen 0-100 arasında bir değer girin?"
Exit Sub
End If
For Each rsm In ActiveDocument.InlineShapes
With rsm
hgt = rsm.Height - (rsm.Height * oran / 100)
wdt = rsm.Width - (rsm.Width * oran / 100)
.LockAspectRatio = msoTrue
.Height = hgt
.Width = wdt
End With
Next
End Sub
.LockAspectRatio = msoTrue
Sub Makro1()
oran = InputBox("Resimler hangi oranda küçültülsün?", "Resim Küçültme", 10)
If oran = "" Then Exit Sub
If oran < 0 Or oran >= 100 Or IsNumeric(oran) = False Then
MsgBox "Lütfen 0-100 arasında bir değer girin?"
Exit Sub
End If
For Each rsm In ActiveDocument.InlineShapes
With rsm
hgt = rsm.Height - (rsm.Height * oran / 100)
wdt = rsm.Width - (rsm.Width * oran / 100)
.Height = hgt
End With
Next
End Sub
oran = InputBox("Resimler hangi oranda küçültülsün?", "Resim Küçültme", 10)
If oran = "" Then Exit Sub
If oran < 0 Or oran >= 100 Or IsNumeric(oran) = False Then
MsgBox "Lütfen 0-100 arasında bir değer girin?"
Exit Sub
End If
For Each rsm In ActiveDocument.InlineShapes
With rsm
hgt = rsm.Height - rsm.Height * oran / 100
.LockAspectRatio = msoTrue
' .LockAspectRatio = msoFalse
.Height = hgt
End With
Next