DigerSayfalarıSil Makrosundaki Diziye Grafik Sayfalarınıda dahil edebilmek

[hsayar]

DigerSayfalarıSil Makrosundaki Diziye Grafik Sayfalarınıda dahil edebilmek

Ferhat hocamın yazdığı seçili olmayan sayfaları diziya alma kodunu diğer sayfaları sil makrosuna çevirdim. ancak Diziye lama işlemi yparken grafik sayfasını dikate almamaktadır.

Hata grafik sayfasına geldii zaman next satırında meydana gelmektedir.
For Each sh In ActiveWorkbook.Sheets satırında For Each sh In ActiveWorkbook.Worksheets şeklinde değişiklik yapıldığında grafik sayfaları diziye dahil edilmiyor. Sh seğişkenini Shett olarak tanımlayınca name hatası veriyor


DEĞİŞKENLER MODULÜNDE

Public sh As Worksheet

Sub DigerSayfalarıSil()
'On Error Resume Next
'.Tag = "HsrXLA03"
'Düzen> Diğer Sayfaları Sil
    If ActiveWorkbook.ProtectStructure = True Then
       MsgBox " Çalışma kitabı korumalıdır, silme işlemi için " & vbCr & _
       " çalışma kitabı korumasını kaldırmanız gerekir!", vbCritical, "Korumalı Kitap"
       Exit Sub
    End If
Dim sayfa, sayfa2 As String, sayfalar, sayfalar2  As String
Dim i%, Y%, X%
Seciliolmayanlar:
Y = 0
For Each sh In ActiveWindow.SelectedSheets
    ReDim Preserve arrSh(Y)
    arrSh(Y) = sh.Name:    Y = Y + 1
Next
Y = 0
    If (UBound(arrSh) + 1) = ActiveWorkbook.Sheets.Count Then GoTo Son 'Exit Sub
    'MsgBox "Tüm Sayfaları seçtiniz zaten, olmayan sayfayı nasıl sileceksiniz?", vbQuestion + vbOKOnly: Exit Sub
 
[COLOR=red][B]'For Each sh In ActiveWorkbook.Sheets  'ThisWorkbook.Sheets[/B][/COLOR]
[COLOR=seagreen][B]For Each sh In ActiveWorkbook.Worksheets  'ThisWorkbook.Sheets
[/B][/COLOR]
    For i = 0 To UBound(arrSh)
        If sh.Name = arrSh(i) Then: X = X + 1
    Next i
    If X = 0 Then
       ReDim Preserve arrShX(Y)
       arrShX(Y) = sh.Name
       Y = Y + 1
    End If
    X = 0
[COLOR=red][B]Next[/B][/COLOR]
 
Dim Prompt As kt_MsgBoxPromptType, rc As Variant: Call ktMsgBoxPromptTypeInit(Prompt)
'------------- SİLMEK İÇİN -----------------
sayfa = "": sayfalar = ""
For i = UBound(arrShX) To 0 Step -1
     sayfa = arrShX(i)
     sayfalar = " " & sayfa & vbCrLf & sayfalar
Next i
For i = 0 To UBound(arrShX)
     Application.DisplayAlerts = False   'ekrana mesaj vermeyi kapat
     With Prompt
       .Message(1) = Sheets(arrShX(0)).Name & " Evete basarsanız silinecektir."
                     .FName(1) = "ROMAN":  .FSize(1) = 16:  .FBold(1) = True: .FColor(1) = vbBlack
       .Message(2) = sayfalar & " Tümüne Evete basarsanız Silinecektir!"
                     .FName(2) = "ROMAN":  .FSize(2) = 16:  .FBold(2) = True: .FColor(2) = vbBlue
       .Message(3) = "Onaylıyor musunuz?"
                     .FName(3) = "CENT":   .FSize(3) = 12:  .FBold(3) = True: .FColor(3) = vbRed
     End With
 
     cevap = ktMsgBoxEX(Prompt, vbCritical, "O N A Y", _
         UserDefBtn:="Tümüne Evet;T,Evet;E,Hayır;H,İptal;P")
 
     If cevap = 9 Then
        Sheets(arrShX()).Delete
        Exit For:        Exit Sub
     ElseIf cevap = 10 Then
        If ActiveWorkbook.Sheets.Count = (UBound(arrSh) + 1) Then
           GoTo Son
        Else
            Sheets(arrShX(i)).Delete
            Sheets(arrSh).Select
            GoTo Seciliolmayanlar
        End If
     ElseIf cevap = 11 Then
        ReDim Preserve arrSh(UBound(arrSh) + 1)
        arrSh(UBound(arrSh)) = Sheets(arrShX(i)).Name
        Sheets(arrSh).Select
        GoTo Seciliolmayanlar
     ElseIf cevap = 12 Then
        Exit For:        Exit Sub
     End If
Next i
Atla:
GoTo Son
Son:
Application.DisplayAlerts = True
Erase arrSh: Erase arrShX
Set sh = Nothing
End Sub

 

[hsayar]

Seçili olmayan sayfalar dizye alınırken içine grafikler nasıl dahil edilmelidir.