Oluşturulan Otomatik Sayfanın Adını Belli Bir Hücreye YAzma

[hilmi0707]

Arkadaşlar otomatik sayfa oluşturma hakkında değerli ustalarımızın da yardımı ile birşeyler yaptık. Ama küçük bir sorun daha var. dosyam ekte . teşekkür ederim

 

[uzmanamele]

merhaba

bu şekilde deneyiniz.

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 <> "Formlar" Then
    [COLOR="Blue"]'Sheets("Formlar").Select[/COLOR]
Else
    Sayfa = Target.Value
    If Sayfa <> "" Then Sheets(Sayfa).Select
End If
Exit Sub
Son:
If Intersect(Target, Sheets("Formlar").[C:C]) 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
            [COLOR="Red"]ActiveSheet.Range("B4") = Target.Value[/COLOR]    
MsgBox Target.Value & " Sayfası Açıldı......", vbOKOnly, "hilmicekic@hotmail.com"
End If
End Sub

bence 'Sheets("Formlar").Select satırını iptal etmeyin, böyle daha iyi.

 

[Korhan Ayhan]

Selamlar,

Alternatif olarak aşağıdaki kodları deneyin.

ThisWorkbook bölümüne;

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Dim Sayfa As String
    
    On Error GoTo Son
    
    Cancel = True
    Sayfa = Target.Value
    If Sayfa <> "" Then Sheets(Sayfa).Select
    Exit Sub
Son:
    If Intersect(Target, Sheets("Formlar").[C:C]) 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
        Range("B4") = Target.Value
        Range("W4") = Target.Offset(0, 1).Value
        MsgBox Target.Value & " Sayfası Açıldı......", vbOKOnly, "[EMAIL="hilmicekic@hotmail.com"]hilmicekic@hotmail.com[/EMAIL]"
    End If
End Sub

Formlar isimli sayfanın kod bölümüne;

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    On Error GoTo Son
    If Intersect(Target, Range("D9:D65536")) Is Nothing Then Exit Sub
    Cancel = True
    Application.ScreenUpdating = False
    If Target.Value <> Empty Then
    Sheets(Target.Offset(0, -1).Text).Select
    Sor = MsgBox(Target.Offset(0, -1).Value & " isimli sayfa silinecektir. Onaylıyor musunuz?", vbCritical + vbYesNo, "Dikkat !")
        If Sor = vbYes Then
            Application.DisplayAlerts = False
            ActiveSheet.Delete
            Application.DisplayAlerts = True
            Sheets("Formlar").Select
            Target.ClearContents
            Target.Offset(0, -1).ClearContents
        End If
    End If
 
Son:
    Application.ScreenUpdating = True
End Sub

 

[hilmi0707]

Korhan hocam çok teşekkürler. alternatif olanları denedim. b4 hücresi ve silme olayı başarılı. Allah razı olsun.
Bir de bu testlerin uygulama tarihini oluşan sayfadaki uygulama tarihi bölümüne yani w4 e nasıl yazdırabiliriz?

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki kodu güncelledim. İncelermisiniz.

 

[makkaya77]

arkadaşlar emeğinize sağlık benimde benzer bir sorunum var hücredeki değer "/" işareti içeriyorsa sayfa adında bu işaret yerine boşluk bırakmak istiyorum. yardımcı olabilirmisiniz

 

[makkaya77]

arkadaşlar emeğinize sağlık benimde benzer bir sorunum var hücredeki değer "/" işareti içeriyorsa sayfa adında bu işaret yerine boşluk bırakmak istiyorum. yardımcı olabilirmisiniz

yardım edecek kimse yokmu