Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
On Error GoTo Son
Dim Sayfa As String
If ActiveSheet.Name <> "index" Then
Sheets("index").Select
Else
Sayfa = Target.Value
If Sayfa <> "" Then Sheets(Sayfa).Select
End If
Exit Sub
Son:
If Intersect(Target, Sheets("index").[B:B]) Is Nothing Then Exit Sub
Sor = MsgBox(Target.Value & " Adlı Sayfa Yok, Eklemek İster Misiniz? ", vbYesNo, Target.Value & " Adlı Sayfanın Açılması")
If Sor = vbYes Then
Sheets("şablon").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Target.Value
MsgBox Target.Value & " Sayfası Açıldı......", vbOKOnly, "ToKeRLeR"
End If
End Sub
Siz degerli hocalarımdan aldıgım bu kodla yıllardır çalışyorum.. yalınız şimdi bu sayfama fazladan şablon eklemem gerek şablon2 şablon3 şablon4 şablon5 şablon6 .. sayfayı eklensinmi diye sormadan önce şablonu seçme şansımız varmı .. hayırlı günler..
On Error GoTo Son
Dim Sayfa As String
If ActiveSheet.Name <> "index" Then
Sheets("index").Select
Else
Sayfa = Target.Value
If Sayfa <> "" Then Sheets(Sayfa).Select
End If
Exit Sub
Son:
If Intersect(Target, Sheets("index").[B:B]) Is Nothing Then Exit Sub
Sor = MsgBox(Target.Value & " Adlı Sayfa Yok, Eklemek İster Misiniz? ", vbYesNo, Target.Value & " Adlı Sayfanın Açılması")
If Sor = vbYes Then
Sheets("şablon").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Target.Value
MsgBox Target.Value & " Sayfası Açıldı......", vbOKOnly, "ToKeRLeR"
End If
End Sub
Siz degerli hocalarımdan aldıgım bu kodla yıllardır çalışyorum.. yalınız şimdi bu sayfama fazladan şablon eklemem gerek şablon2 şablon3 şablon4 şablon5 şablon6 .. sayfayı eklensinmi diye sormadan önce şablonu seçme şansımız varmı .. hayırlı günler..