- Katılım
- 2 Mart 2005
- Mesajlar
- 2,960
- Excel Vers. ve Dili
-
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
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
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
Kod:
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
Son düzenleme: