otomotik sayaç no versin

[bilisim2010]

merhaba textboxdaki 10000 ile başlayan sayacı bir buton ile şarta bağlı +1 artıırayım şartım da, kaydet butonuna basınca eğer texboxdaki no sayfa isimlerinden herhangi birinde varsa o numaranın bir üstünü oluştursun. dikkat ! sayfadaki hücre demiyorum sayfanın bizzat adı 10001 ise textboxdaki sayacı 10002 yapacak 10002 varsa 10003 yapacak. şimdiden teşekkürler kıymetli değerli uzman üstadlarım.

 

[volki_112]

merhaba textboxdaki 10000 ile başlayan sayacı bir buton ile şarta bağlı +1 artıırayım şartım da, kaydet butonuna basınca eğer texboxdaki no sayfa isimlerinden herhangi birinde varsa o numaranın bir üstünü oluştursun. dikkat ! sayfadaki hücre demiyorum sayfanın bizzat adı 10001 ise textboxdaki sayacı 10002 yapacak 10002 varsa 10003 yapacak. şimdiden teşekkürler kıymetli değerli uzman üstadlarım.

istediğiniz kod

Private Sub btnKaydet_Click()
    Dim ws As Worksheet
    Dim mevcutNo As Long
    Dim yeniNo As Long
    Dim mevcutMu As Boolean

    ' TextBox'taki mevcut numarayı al
    mevcutNo = CLng(Me.TextBox1.Value)
    yeniNo = mevcutNo

    ' Numara mevcutsa +1 artırarak benzersiz hale getir
    Do
        mevcutMu = False
        For Each ws In ThisWorkbook.Sheets
            If ws.Name = CStr(yeniNo) Then
                mevcutMu = True
                Exit For
            End If
        Next ws
        If mevcutMu Then yeniNo = yeniNo + 1
    Loop While mevcutMu

    ' Benzersiz numarayı TextBox'a yaz
    Me.TextBox1.Value = yeniNo
End Sub

 

[bilisim2010]

istediğiniz kod

Private Sub btnKaydet_Click()
    Dim ws As Worksheet
    Dim mevcutNo As Long
    Dim yeniNo As Long
    Dim mevcutMu As Boolean

    ' TextBox'taki mevcut numarayı al
    mevcutNo = CLng(Me.TextBox1.Value)
    yeniNo = mevcutNo

    ' Numara mevcutsa +1 artırarak benzersiz hale getir
    Do
        mevcutMu = False
        For Each ws In ThisWorkbook.Sheets
            If ws.Name = CStr(yeniNo) Then
                mevcutMu = True
                Exit For
            End If
        Next ws
        If mevcutMu Then yeniNo = yeniNo + 1
    Loop While mevcutMu

    ' Benzersiz numarayı TextBox'a yaz
    Me.TextBox1.Value = yeniNo
End Sub

hocam teşekkür ederim bu koda eğer yoksa textboxdaki sayfayı oluştur u ekleyebilirmisin?

 

[volki_112]

hocam teşekkür ederim bu koda eğer yoksa textboxdaki sayfayı oluştur u ekleyebilirmisin?

İstedigin kod
Private Sub btnKaydet_Click()
Dim ws As Worksheet
Dim mevcutNo As Long
Dim yeniNo As Long
Dim mevcutMu As Boolean

' TextBox'taki mevcut numarayı al
mevcutNo = CLng(Me.TextBox1.Value)
yeniNo = mevcutNo

' Numara mevcutsa +1 artırarak benzersiz hale getir
Do
mevcutMu = False
For Each ws In ThisWorkbook.Sheets
If ws.Name = CStr(yeniNo) Then
mevcutMu = True
Exit For
End If
Next ws
If mevcutMu Then yeniNo = yeniNo + 1
Loop While mevcutMu

' Benzersiz numarayı TextBox'a yaz
Me.TextBox1.Value = yeniNo

' Sayfa oluştur
Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = CStr(yeniNo)

' Değişkenleri temizle
Set ws = Nothing
End Sub