Daire çaplarını küçültmek

[35ibo45]

Arkadaşlar selam.
1000 sayfanın üzerinde sunum hazırladım.
Bu sayfaların bir çoğunda 14 mm. çapında DAİRE şekilleri var.
Ben bunların çapını 10 mm olarak değiştirmek istiyorum.
Önemli olan şu :
Daire şekillerinin bulunduğu sayfalarda kare şekiller de var. Ben sadece daire şekillerinin çaplarını küçültmek istiyorum.
Şimdiden teşekkürler.

 

[Korhan Ayhan]

Merhaba,

Toplu işlemler için makro kullanabilirsiniz.

Option Explicit

Sub Resize_Circles()
    Dim My_Slide As Slide
    Dim My_Shape As Shape
    Dim X As Integer
    Dim Y As Integer
    
    For Each My_Slide In ActivePresentation.Slides
        For Each My_Shape In My_Slide.Shapes
            My_Shape.Select msoTrue
            If My_Shape.AutoShapeType = msoShapeOval Then
                X = (My_Shape.Width / 28.3464568001883 * 10)
                Y = (My_Shape.Height / 28.3464568001883 * 10)
                If X = 14 And Y = 14 Then
                    My_Shape.Width = 28.3464568001883
                    My_Shape.Height = 28.3464568001883
                End If
            End If
        Next
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[35ibo45]

Sub Resize_Circles() Dim My_Slide As slide Dim My_Shape As shape For Each My_Slide In ActivePresentation.Slides For Each My_Shape In My_Slide.Shapes If My_Shape.AutoShapeType = msoShapeOval Then If My_Shape.Width = 14 And My_Shape.Height = 14 Then My_Shape.Width = 10 My_Shape.Height = 10 End If End If Next Next MsgBox "İşleminiz tamamlanmıştır.", vbInformation End Sub

Korhan Hocam selam.
Öncelikle ilginize ve emeğinize teşekkür ederim.
Kodları uyguladım fakat maalesef çalışmadı.

Tekrar teşekkürler.

 

[Korhan Ayhan]

Kullandığınız şekil tipi farklı olabilir. Küçük bir örnek sunum paylaşırsanız deneyebilirim.

 

[35ibo45]

Kullandığınız şekil tipi farklı olabilir. Küçük bir örnek sunum paylaşırsanız deneyebilirim.

Sayın hocam tekrar merhaba.
Üye olmadığımız için dosya yükleyemiyoruz.

 

[Korhan Ayhan]

Dosya yüklemeyle ilgili kısıtlama yoktur. Altın üyelik sahibi olanlar forumun arşivine dosya yükleyebilirler.

Bunun avantajı şudur;

Yüklediğiniz belgeler forumun başına birşey gelmediği sürece kaybolmaz.

Altın Üyelik dışında harici dosya barındırma sitelerini kullanarak belge paylaşabilirsiniz.

Bunun dezavantajı şudur;

Yüklediğiniz belgeler bir süre sonra erişilmez olacaktır. (Tabiri caizse link ölecektir...)

 

[35ibo45]

Dosya yüklemeyle ilgili kısıtlama yoktur. Altın üyelik sahibi olanlar forumun arşivine dosya yükleyebilirler.

Bunun avantajı şudur;

Yüklediğiniz belgeler forumun başına birşey gelmediği sürece kaybolmaz.

Altın Üyelik dışında harici dosya barındırma sitelerini kullanarak belge paylaşabilirsiniz.

Bunun dezavantajı şudur;

Yüklediğiniz belgeler bir süre sonra erişilmez olacaktır. (Tabiri caizse link ölecektir...)

Şimdi gülme zamanı.
Başaramadım (BECEREMEDİM dersem daha iyi olur sanırım.) sayın hocam.
Dosya yükleme linki verebilirseniz (belki) başarırım. ))))

 

[Tevfik_Kursun]

Merhaba,
dosya.co , GoogleDrive , ... ya da herhangi bir dosya paylaşım sitesi ne yükleyebilirsiniz.
Google da dosya paylaşım sitesi diye aratsanız da bulursunuz.

 

[35ibo45]

Merhaba,
dosya.co , GoogleDrive , ... ya da herhangi bir dosya paylaşım sitesi ne yükleyebilirsiniz.
Google da dosya paylaşım sitesi diye aratsanız da bulursunuz.

Tevfik Bey.
Çok teşekkür ederim.

 

[35ibo45]

Dosya yüklemeyle ilgili kısıtlama yoktur. Altın üyelik sahibi olanlar forumun arşivine dosya yükleyebilirler.

Bunun avantajı şudur;

Yüklediğiniz belgeler forumun başına birşey gelmediği sürece kaybolmaz.

Altın Üyelik dışında harici dosya barındırma sitelerini kullanarak belge paylaşabilirsiniz.

Bunun dezavantajı şudur;

Yüklediğiniz belgeler bir süre sonra erişilmez olacaktır. (Tabiri caizse link ölecektir...)

İndir Grubu pptm

Dosyayı indir Grubu pptm

dosya.co

Sayın Korhan Hocam.
Yükledim. Şimdiden teşekkürler

 

[necati]

Korhan Hocam selam.
Öncelikle ilginize ve emeğinize teşekkür ederim.
Kodları uyguladım fakat maalesef çalışmadı.

Tekrar teşekkürler.

Merhaba,
Makroda kullanılan ölçü birimi points cinsinden olmalı.
14 mm de 39.68504 points yapıyor. Makrodaki 14 rakamlarını değiştirmeniz yeterli.
10 mm'de yaklaşık 28 points'e karşılık geliyor.

 

[Korhan Ayhan]

Merhaba,

Şekil ölçüleri VBA tarafında "points" olduğu için beni yanılttı. Önerdiğim kodu revize ettim. Tekrar deneyiniz.

 

[35ibo45]

Merhaba,

Şekil ölçüleri VBA tarafında "points" olduğu için beni yanılttı. Önerdiğim kodu revize ettim. Tekrar deneyiniz.

Sayın hocam selam.
My_Shape.Select msoTrue
satırı debug veriyor.

 

[Korhan Ayhan]

Hata veren satırı silip deneyiniz..

 

[35ibo45]

Hata veren satırı silip deneyiniz..

İşlem tamam.. Süper. İlginize, bilginize, emeğinize, yüreğinize sağlık.