- Katılım
- 13 Mayıs 2005
- Mesajlar
- 761
- Excel Vers. ve Dili
- 2010 Türkçe
- Altın Üyelik Bitiş Tarihi
- 03.11.2024
Aşağıdaki kod ile E 21 hücresine istemediğim sayfaları getirmiyorum. Ama kodu çalıştırdığımda hiç sayfa olmasa bile D21 hücresinde son sildiğim yada seçtiğim sayfanın adı kalıyor. Sayfa yok ama gölgesi var. Sayfa yoksa hücrede hiçbişey gözükmese.
Kod:
Private Sub Workbook_NewSheet(ByVal Sh As Object)
VeriDogrulama
End Sub
Private Sub Workbook_SheetBeforeDelete(ByVal Sh As Object)
VeriDogrulama
End Sub
Sub VeriDogrulama()
Sheets("Sabitler").Select
ActiveSheet.Unprotect "61"
Dim Sh As Worksheet, _
Syf As String
For Each Sh In Worksheets
If Not Sh.Name = "Sabitler" And Not Sh.Name = "Puantaj" And Not Sh.Name = "Ekstra" And Not Sh.Name = "F.Mesai" _
And Not Sh.Name = "Günlük Çal.Çiz." And Not Sh.Name = "Personel Listesi" And Not Sh.Name = "Fiili Görevler" _
And Not Sh.Name = "Kodlar" And Not Sh.Name = "Vardiyalar" And Not Sh.Name = "Resmi Tatiller" _
And Not Sh.Name = "Puantaj Açıklamaları" And Not Sh.Name = "ArşivP" And Not Sh.Name = "ArşivF.M." _
And Not Sh.Name = "MesaiCetveliPersonel" And Not Sh.Name = "49A-B" And Not Sh.Name = "Dinamik Vardiya" _
And Not Sh.Name = "İşletmeler" And Not Sh.Name = "D_V_Yedek" And Not Sh.Name = "F.MesaiVeri" Then
If Syf = "" Then
Syf = Sh.Name
Else
Syf = Syf & "," & Sh.Name
End If
End If
Next Sh
If Syf = "" Then
MsgBox "Puantaj Sayfası Yok", vbInformation
Sheets("Sabitler").Select
ActiveSheet.Protect "61", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
Exit Sub
End If
With Sheets("Sabitler").Range("E21").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Syf
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
MsgBox "Arşiv Puantaj sayfaları güncellendi..!", vbInformation
Sheets("Sabitler").Select
ActiveSheet.Protect "61", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
End Sub