DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub YoksaEkle()
Dim Sh As String
Sh = [C2]
If Not SheetExist(Sh) Then
Set NewSh = Sheets.Add(After:=Sheets(Sheets.Count))
NewSh.Name = Sh
End If
Set NewSh = Nothing
End Sub
'
Function SheetExist(ShName As String) As Boolean
On Error Resume Next
SheetExist = IIf(Sheets(ShName).Select, True, False)
End Function
Kod:Sheets.Add After:=Sheets(Sheets.Count) Sheets(ActiveSheet.Name).Name = [C2]
komutu ile c2 hcresindeki isme göre yeni bir sayfa oluşturuyorum. Ancak aynı isimde bir sayfa varsa uyarsın istiyorum. Kontrol kodunu yazamadım. Yardım lütfen.
Option Explicit
Sub sayfa_Aç_61()
On Error GoTo son
Dim ts, kaplan, trabzonspor As String
Set kaplan = Sheets("Sayfa1")
If ActiveSheet.Name = kaplan.Range("A3").Text Then
Sheets(kaplan.Range("A3").Text).Select
Else
trabzonspor = kaplan.Range("A3").Value
If trabzonspor <> "" Then Sheets(trabzonspor).Select
End If
Exit Sub
son:
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = kaplan.Range("A3")
End Sub
Sub YoksaEkle()
Dim Sh As String
Sh = [C2]
If Not SheetExist(Sh) Then
Set NewSh = Sheets.Add(After:=Sheets(Sheets.Count))
NewSh.Name = Sh
Else
MsgBox "Aynı isimli bir sayfa mevcut ": Exit Sub
End If
Set NewSh = Nothing
End Sub
'
Function SheetExist(ShName As String) As Boolean
On Error Resume Next
Application.ScreenUpdating = False
AktifSayfa = ActiveSheet.Name
SheetExist = IIf(Sheets(ShName).Select, True, False)
Sheets(AktifSayfa).Select
Application.ScreenUpdating = True
End Function
Sub ekle()
Application.ScreenUpdating = False
If ActiveWorkbook.Sheets("Taslak").Range("C2").Value = "" Then
MsgBox "Müşteri adını girmediniz.", vbCritical, " UYARI"
Exit Sub
End If
For a = 1 To Sheets.Count
If Sheets(a).Name = ActiveWorkbook.Sheets("Taslak").Range("C2").Value Then
MsgBox "" & ActiveWorkbook.Sheets("Taslak").Range("C2").Value & "" & vbLf & "Adına kayıtlı sayfa var ", vbCritical, " HATA"
Exit Sub
End If
Next
If MsgBox("" & ActiveWorkbook.Sheets("Taslak").Range("C2").Value & "" & vbLf & "Adına kayıtlı sayfa yok " & vbLf & "Şimdi açılsın mı ?", vbQuestion + vbYesNo, " BİLGİ") = vbYes Then
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Select
ActiveSheet.Name = ActiveWorkbook.Sheets("Taslak").Range("C2").Value
End If
Application.ScreenUpdating = True
End Sub