Sayfadaki şekilleri topluca silme

[ockucukay]

ActiveSheet.Shapes.Range(Array("Line 130", "Group 131")).Select
Selection.Delete

Merhaba

ben çalışma sayfasında bulunan tüm şekilleri tek tıklamayla silmek istiyorum. ama yukarıdaki kodda gördüğünüz gibi bunların kimi grup halde, kimi daire, kimi dikdörtgen vb. hepsini birden nasıl silebilirim? İlginiz için şimdiden teşekkür ederim.

 

[Kemal Demir]

ockucukay,

Emin olmamakla bereber şunu soylemek istiyorum.Nesneler birinden farklı.Nedeni bu olabilir.

Yanlıs bir şeyse bilgilendirme için kusura bakmayınız.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kod aktif sayfadaki tüm nesneleri siler.

Sub SAYFADAKİ_TÜM_NESNELERİ_SİL()
    ActiveSheet.DrawingObjects.Delete
End Sub

 

[uzmanamele]

merhaba
aşağıdaki link size farklı fikirler verebilir. syn Ferhat betin kodları bana yeni fikirler verdi, ilceleyiniz.

http://www.excel.web.tr/showthread.php?t=52969

 

[ockucukay]

Application.ScreenUpdating = False
Sheets("süz").Visible = True
Sheets("süz").Select
Rows("1:300").Select
Selection.Delete Shift:=xlUp

Dim sp As Shape
Dim arrShape() As Variant
Dim i As Integer

With ActiveSheet

For Each sp In .Shapes
If sp.AutoShapeType = msoShapeRectangle Or _
sp.Type = msoLine Then
'If sp.Type = msoAutoShape Or sp.Type = msoLine Then
i = i + 1
ReDim Preserve arrShape(1 To i)
arrShape(i) = sp.Name
End If
Next

.Shapes.Range(arrShape).Select
Selection.Delete

End With

sayın uzmanamele, sayın korhan ayhan

verdiğiniz kodları denedim, ama nedense silmiyor. kullandığım şekiller çizim toolbarındada görebileceğiniz ok, çizgi, dikdörtgen,oval ve bazende bu şekillerden gruplayarak yaptığım şekiller.yukarıda benim kodumun içine koyduğum ve sayın ferhat pazarçevirdi'nin sayın uzmanamele'ye verdiği kodları göreceksiniz.malesef çalışmadı, sorun ne olabilir acaba?

 

[hamitcan]

Activesheet.Shapes.SelectAll 
Selection.delete

şeklinde denediniz mi?

 

[ersoyalan]

Merhaba,

Bir örnekte ben vereyim ustalarım..İnşallah soruyu yanlış anlamamışımdır.

Syg,
E.ALAN

 

[ockucukay]

Merhaba,

Bir örnekte ben vereyim ustalarım..İnşallah soruyu yanlış anlamamışımdır.

Syg,
E.ALAN

Do
If ActiveWorkbook.ActiveSheet.Shapes.Count > 0 Then
ActiveSheet.Shapes(1).Delete
Else
Exit Do
End If
Loop

tamamdır sayın ersoy alan'ın verdiği kodlar çok güzel çalıştı. Hatta biraz fazla güzel çalışıp sayfaya koydğum düğmeleride sildi . bunu belli bir aralık için yapabilirmiyiz örneğin R1:R300 aralığı için. ilginize teşekkür ederim.

 

[ersoyalan]

Vallahi hocam okadarını açıkçası bilemiyorum.Bende hazır dosya vardı onu gönderdim.
Syg,

 

[ockucukay]

yinede teşekkür ederim yardımlarınız için sayın ersoy alan. sorumu tekrarlayayım o zaman:

Do
If ActiveWorkbook.ActiveSheet.Shapes.Count > 0 Then
ActiveSheet.Shapes(1).Delete
Else
Exit Do
End If
Loop

bunu belli bir aralık için yapabilirmiyiz örneğin R1:R300 aralığı için. ilginize teşekkür ederim.

 

[uzmanamele]

merhaba
örnek dosya ekleyebilirmisiniz.
gruplandırılmış şekilleri silmiyorsa, önce grubu çözüp sonra sildirmeyi deneyin.

 

[ockucukay]

merhaba
örnek dosya ekleyebilirmisiniz.
gruplandırılmış şekilleri silmiyorsa, önce grubu çözüp sonra sildirmeyi deneyin.

Do
If ActiveWorkbook.ActiveSheet.Shapes.Count > 0 Then
ActiveSheet.Shapes(1).Delete
Else
Exit Do
End If
Loop


eksik anlattım sanırım, sayfadaki tüm şekilleri siliyor yukarıdaki kod, ben sadece sayfanın belli bir aralığındaki tüm şekilleri silsin istiyorum. yani nasıl tanımlayabilirsek aralığı seçsin, seçilen aralıktaki tüm şekilleri silsin. anlatabilmişimdir umarım.ilginize tekrar teşekkür ederim.

 

[Ferhat Pazarçevirdi]

Örnek olması açısından, aşağıdaki kod, A1:C10 aralığındaki tüm şekilleri siler. İnceleyiniz.

Sub Belirli_Bir_Alandaki_Sekilleri_Sil()
    
    Dim sekiL As Shape
    
    For Each sekiL In ActiveSheet.Shapes
        If Not Intersect(sekiL.TopLeftCell, Range("A1:C10")) Is Nothing Then
            sekiL.Delete
        End If
    Next
 
End Sub

 

[ersoyalan]

Hocam süper olmuş.Ellerinize sağlık.

 

[ockucukay]

cevabınızı yeni gördüm, bende makroyla buton ekleme gibi yollar arıyordum.üstadım muhteşemsiniz, ellerinize sağlık.