Textbox a sadece geçerli saat ve dakika girilebilsin

antonio

Destek Ekibi
Destek Ekibi
Katılım
13 Şubat 2011
Mesajlar
1,161
Excel Vers. ve Dili
Microsoft Office Professional Plus 2013 Türkçe
Userform üzerine yerleştirdiğim bir textboxa, sadece geçerli bir saat ve dakika değeri girilebilsin istiyorum. Bunun için:
1) ##:## şeklinde toplam 5 karaktere müsaade etsin.
2) ilk iki rakam saat değeri içindir. saat rakamından sonra ".,;:-_" karakterlerden hangisi girilirse girilsin, ":" üst üste iki nokta olarak yazsın.
3) ikinci karakter olarak da yukarıda ki ayıraçların tümüne müsade etsin, ancak ilk karakter olarak sadece 0-9 arası değer girilebilsin. ikinci karakter olarak ayıraç girilirse, otomatik olarak 0#: formatı oluştursun ve dakika kısmına geçsin.
4) 4. karakterler sadece 0-5 arası bir veriye müsaade etsin.
5) 5.karakterler sadece 0-9 arası karakterlere müsaade etsin
Örnekler:
Kullanıcı 8,25 yazarsa 08:25 formatına dönüşsün.
kullanıcı 8 yazarsa 08:00 formatına dönüşsün.
kullanıcı 8.5 yazarsa 08:50 formatına dönüşsün.
Önceden kafa yoran, düşünen ve paylaşan her kese teşekkürlerimi ve saygılarımı sunarım.
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,056
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Textbox1'e aşağıdaki kodları yazarsanız yanlış yazıma izin vermeyecek ve tüm istediklerinizi gerçekleştirecektir.

Kod:
Private Sub TextBox1_Change()
If Len(TextBox1) > 5 Then
SendKeys "{bs}"
Exit Sub
End If
Set nesne = CreateObject("VBScript.Regexp")
Select Case Len(TextBox1)
Case 1: nesne.Pattern = "^[0-2]"
Case 2: nesne.Pattern = "[COLOR="Red"]^(([01][0-9])|(2[0-3]))[/COLOR]"
Case 4: nesne.Pattern = "([0-23]):([0-5])"
Case 5: nesne.Pattern = "([0-23]):([0-59])"
End Select
nesne.Global = True
If nesne.Test(TextBox1.Value) = False Then
SendKeys "{bs}"
Exit Sub
End If
If Len(TextBox1) = 2 Then TextBox1 = TextBox1 & ":"
Set nesne = Nothing
End Sub
 

antonio

Destek Ekibi
Destek Ekibi
Katılım
13 Şubat 2011
Mesajlar
1,161
Excel Vers. ve Dili
Microsoft Office Professional Plus 2013 Türkçe
Textbox1'e aşağıdaki kodları yazarsanız yanlış yazıma izin vermeyecek ve tüm istediklerinizi gerçekleştirecektir.

Kod:
Private Sub TextBox1_Change()
If Len(TextBox1) > 5 Then
SendKeys "{bs}"
Exit Sub
End If
Set nesne = CreateObject("VBScript.Regexp")
Select Case Len(TextBox1)
Case 1: nesne.Pattern = "^[0-2]"
Case 2: nesne.Pattern = "^[0-23]{2}"
Case 4: nesne.Pattern = "([0-23]):([0-5])"
Case 5: nesne.Pattern = "([0-23]):([0-59])"
End Select
nesne.Global = True
If nesne.Test(TextBox1.Value) = False Then
SendKeys "{bs}"
Exit Sub
End If
If Len(TextBox1) = 2 Then TextBox1 = TextBox1 & ":"
Set nesne = Nothing
End Sub
Sayın Leventm, saat kısmında sorun var.
ilk rakam 0 ise ikinci rakam olarak 3 ün üzerinde rakam yazılamıyor. Oysa kullanıcı 05:25 gibi bir şey yazmak isteyebilir. Diğer bir sorun da, ilk rakam ile ilgili, şöyle ki 2 nin üzerinde bir rakamla başlangıç yapılamıyor. Kullanıcı sadece 8.25 yazabilmelidir. noktalama işaretlerinden her hangi birini algıladığı zaman kullanıcının saat kısmını bitirdiğini anlamalı, bunu 08:25 formatına dönüştürmelidir. Başka bir deyişle ilk rakam olarak 3 ve yukarısı bir rakam girildiği zaman, bu rakamın önüne otomatik 0 eklemeli ve sadece noktalama işareti basmasına müsaade etmelidir. Acaba bu mümkün müdür? Saygılarımla.
 

bluefalcon

Altın Üye
Altın Üye
Katılım
22 Aralık 2005
Mesajlar
418
Excel Vers. ve Dili
Microsoft 365
Altın Üyelik Bitiş Tarihi
03.12.2025
Merhaba,

Kodu hazırlamakta olduğum bir projemde bulunan Userformdaki textbox da denedim. Gayet güzel düşünülmüş. Yalnız, mesela 17:25 yazacaksanız yazamıyorsunuz. 24 saat baz alındığında sorun çıkarıyor. Birkaç deneme yaptım ama içinden çıkamadım.
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,056
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Merhaba,

Kodu hazırlamakta olduğum bir projemde bulunan Userformdaki textbox da denedim. Gayet güzel düşünülmüş. Yalnız, mesela 17:25 yazacaksanız yazamıyorsunuz. 24 saat baz alındığında sorun çıkarıyor. Birkaç deneme yaptım ama içinden çıkamadım.
2. mesajımdaki kodda kırmızı olarak renklendirdiğim düzeltmeyi yaptım. Bu şekilde deneyebilirsiniz.
 
Katılım
20 Şubat 2012
Mesajlar
114
Excel Vers. ve Dili
Excel 2013 TR
Merhabalar, bu şekilde bir textbox ilerleyen günlerde bana da lazım olacağından farklı bir başlık açmak yerine güncel konu altına yazmak istedim.
Benim istemiş olduğum kodda
Saat girilecek olan textbox ta karakter yazmadan karakteri kendisi koysun. Yani
0012 yada 012 yazınca 00:12
725 yada 0725 yazınca 07:25
1951 yazınca 19:51 yazsın.

Ayrıca tarih textboxu da aynı özellikte olsun. Yani
010116 yada 01012016 yada 1116 yazıldığında 01.01.2016 şeklinde yazsın.

Eğer mümkünse böyle 2 farklı textbox kullanacağım. Henüz vba konusunda çok yeniyim. Yardımcı olan herkese teşekkür ederim.
Mesajımı düzeltiyorum.

Sayın Levent beyin vermiş olduğu saat formatını kendi userformuma uyarladım gayet güzel çalışıyor. Teşekkürler.

Kendimce saat formatlı kodu tarih formatına uyarlamaya çalıştım fakat yıl kısmında takıldım. Editlemiş olduğum kod aşağıdaki gibidir.
Kod:
Private Sub TextBox1_Change()
If Len(TextBox1) > 8 Then
SendKeys "{bs}"
Exit Sub
End If
Set nesne = CreateObject("VBScript.Regexp")
Select Case Len(TextBox1)
Case 1: nesne.Pattern = "^[0-3]"
Case 2: nesne.Pattern = "^(([01][1-9])|(3[1]))"
Case 4: nesne.Pattern = "([01-31]).([0-1])"
Case 5: nesne.Pattern = "([01-31]).(([1][1-2])|(1[2]))"
Case 7: nesne.Pattern = "([01-31]).([01-12]).([1])"
Case 8: nesne.Pattern = "([01-31]).([01-12]).(([1])|([16]))"
End Select
nesne.Global = True
If nesne.Test(TextBox1.Value) = False Then
SendKeys "{bs}"
Exit Sub
End If
[COLOR="Red"]If Len(TextBox1) = 2 Then TextBox1 = TextBox1 & "."[/COLOR]
Set nesne = Nothing
End Sub
Bu koda göre gün 01-31 aralığında ay 01-12 aralığında yazılıyor. Fakat yıl için rakam yazmaya devam ettiğimde 31.12222 şeklinde oluyor. Hatamın kırmızı yazılı alandan olduğunu düşünüyorum ama nasıl düzelteceğim konusunda fikrim yok. Dediğim gibi vba konusunda henüz çok yeniyim kusurum olduysa affola. Bir de yanlış yazdığım saat yada tarihi backspace ile silmeye kalktığımda ":" ve "." işaretlerini silmiyor. Ya en başa gelip delete ile siliyorum yada tümünü seçip siliyorum. Bu konuda da yardımcı olabilme imkanınız varsa memnun olurum.
 
Son düzenleme:

antonio

Destek Ekibi
Destek Ekibi
Katılım
13 Şubat 2011
Mesajlar
1,161
Excel Vers. ve Dili
Microsoft Office Professional Plus 2013 Türkçe
2. mesajımdaki kodda kırmızı olarak renklendirdiğim düzeltmeyi yaptım. Bu şekilde deneyebilirsiniz.
Sayın Leventm, ilk karakter olarak 2 den büyük (9 dahil) bir karakter girilirse (örn: 5), bunu otomatik olarak "05:" şekline dönüştürsün, dakika kısmına da ilk karakter olarak 5 den büyük (6-9 arası) sayı girilirse (örn: 7) bunu otomatik olarak "07" olarak algılasın. Mümkün mü?
 
Katılım
20 Şubat 2012
Mesajlar
114
Excel Vers. ve Dili
Excel 2013 TR
Konuya yardımcı olacak arkadaş var mı acaba?
 
Katılım
20 Şubat 2012
Mesajlar
114
Excel Vers. ve Dili
Excel 2013 TR
Tarih için kodu şu şekilde değiştirdim fakat yılı yazamıyorum. Yardımcı olur musunuz lütfen arkadaşlar...

Kod:
Private Sub TextBox2_Change()
If Len(TextBox1) > 8 Then
SendKeys "{bs}"
Exit Sub
End If
Set nesne = CreateObject("VBScript.Regexp")
Select Case Len(TextBox2)
Case 1: nesne.Pattern = "^[0-3]"
Case 2: nesne.Pattern = "^(([01][1-9])|[1][0-9]|([2][0-9])|(3[0-1]))"
Case 4: nesne.Pattern = "([01-31]).([0-1])"
Case 5: nesne.Pattern = "([01-31]).(([0][1-9]|[1][0-2]))"
Case 7: nesne.Pattern = "([01-31]).([01-12]).([1])"
Case 8: nesne.Pattern = "([01-31]).([01-12]).([1][6-7])"
End Select
nesne.Global = True
If nesne.Test(TextBox2.Value) = False Then
SendKeys "{bs}"
Exit Sub
End If
If Len(TextBox2) = 2 Then TextBox2 = TextBox2 & "."
If Len(TextBox2) = 5 Then TextBox2 = TextBox2 & "."
Set nesne = Nothing
End Sub
 
Katılım
20 Şubat 2012
Mesajlar
114
Excel Vers. ve Dili
Excel 2013 TR
Arkadaşlar yardımcı olabilecek biri yok mu? Tarih olayında günü ve ayı yazdırıyorum fakat yılı bir türlü yazdıramadım. Lütfen yardımcı olursanız çok sevinirim.
 
Katılım
20 Şubat 2012
Mesajlar
114
Excel Vers. ve Dili
Excel 2013 TR
Textbox1'e aşağıdaki kodları yazarsanız yanlış yazıma izin vermeyecek ve tüm istediklerinizi gerçekleştirecektir.

Kod:
Private Sub TextBox1_Change()
If Len(TextBox1) > 5 Then
SendKeys "{bs}"
Exit Sub
End If
Set nesne = CreateObject("VBScript.Regexp")
Select Case Len(TextBox1)
Case 1: nesne.Pattern = "^[0-2]"
Case 2: nesne.Pattern = "[COLOR="Red"]^(([01][0-9])|(2[0-3]))[/COLOR]"
Case 4: nesne.Pattern = "([0-23]):([0-5])"
Case 5: nesne.Pattern = "([0-23]):([0-59])"
End Select
nesne.Global = True
If nesne.Test(TextBox1.Value) = False Then
SendKeys "{bs}"
Exit Sub
End If
If Len(TextBox1) = 2 Then TextBox1 = TextBox1 & ":"
Set nesne = Nothing
End Sub
Sanırım konuyu kendim çözdüm :) Yani aslında tam olarak çözdüğüm söylenemez. Fakat farklı bir çözüm yolu buldum.
Belki başkalarına da lazım olur diye paylaşma gereği duydum.
Öncelikle tarihte gün ve ay kısımlarındaki sorunu çözdüm fakat yıl kısmında noktadan sonra 1 rakamını şarta bağladığımda farklı rakamlar girilebildiğini, 1 dışında rakam yazıldığında ise yazılan rakamın dışında başka bir rakam girilemediğini gördüm. Kod bilgim iyi olmadığı için nedenini bilmiyorum. Ama bana lazım olan içinde bulunduğumuz yılı yazması gerektiğinden ay kısmından sonra nokta işaretiyle birlikte 16 yazdırdım ve bu şekilde kendimce çözüm buldum. Kod aşağıdaki şekildedir.

Kod:
Private Sub TextBox2_Change()
If Len(TextBox2) > 8 Then
SendKeys "{bs}"
Exit Sub
End If
Set nesne = CreateObject("VBScript.Regexp")
Select Case Len(TextBox2)
Case 1: nesne.Pattern = "^[0-3]"
Case 2: nesne.Pattern = "^(([01][1-9])|([1][0-9])|([2][0-9])|(3[0-1]))"
Case 4: nesne.Pattern = "([0-1])"
Case 5: nesne.Pattern = "(([0][1-9]|[1][0-2]))"
End Select
nesne.Global = True
If nesne.Test(TextBox2.Value) = False Then
SendKeys "{bs}"
Exit Sub
End If
If Len(TextBox2) = 2 Then TextBox2 = TextBox2 & "."
If Len(TextBox2) = 5 Then TextBox2 = TextBox2 & ".16"
Set nesne = Nothing
End Sub
Ayrıca bluefalcon un demiş olduğu gibi saat 15'ten 19'a kadar olan zaman diliminde 15:30 19:30 gibi yazım yapılamıyordu. Orda da yine kendimce denemeler yaparak aşağıdaki kod ile sorunu hallettim. Lazım olan arkadaşlara faydalı olacaktır.

Kod:
Private Sub TextBox1_Change()
If Len(TextBox1) > 5 Then
SendKeys "{bs}"
Exit Sub
End If
Set nesne = CreateObject("VBScript.Regexp")
Select Case Len(TextBox1)
Case 1: nesne.Pattern = "^[0-2]"
Case 2: nesne.Pattern = "^(([01][0-9])|(2[0-3]))"
Case 4: nesne.Pattern = "(:[0-5])"
Case 5: nesne.Pattern = "([0-9])"
End Select
nesne.Global = True
If nesne.Test(TextBox1.Value) = False Then
SendKeys "{bs}"
Exit Sub
End If
If Len(TextBox1) = 2 Then TextBox1 = TextBox1 & ":"
Set nesne = Nothing
End Sub
Herkese teşekkürler iyi çalışmalar dilerim.
 

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,662
Excel Vers. ve Dili
Microsoft 365 Tr-64
Eski bir konu ama ben de aynı problemi yaşağınca @Levent Menteşoğlu beyin çalışmasına bir kaç ilave ile istediğimi elde ettim.
Change haricinde BeforeUpdate olayını ve bir adet te Function kullandım.
Textboxa tüm varyosyanları denedim. Hepsinde sonuç olumlu.
Deneyip olumsuz sonuç alanlar bildirebilir.

C++:
Private Sub TextBox1_Change()
    If Len(TextBox1) > 5 Then
        SendKeys "{bs}"
        Exit Sub
    End If
    If Len(Me.TextBox1) = 2 And Right(Me.TextBox1, 1) = ":" Then Me.TextBox1 = "0" & Me.TextBox1: Exit Sub
    Set nesne = CreateObject("VBScript.Regexp")
    Select Case Len(TextBox1)
        Case 1: nesne.Pattern = "^[0-9]"
        Case 2: nesne.Pattern = "^(0[0-9]|1[0-9]|2[0-3])$"
        Case 3: nesne.Pattern = "^(0[0-9]|1[0-9]|2[0-3]):$"
        Case 4: nesne.Pattern = "^(0[0-9]|1[0-9]|2[0-3]):[0-9]$"
        Case 5: nesne.Pattern = "^(0[0-9]|1[0-9]|2[0-3]):[0-5][0-9]$"
    End Select
    nesne.Global = True
    If nesne.Test(TextBox1.Value) = False Then
        SendKeys "{bs}"
        Exit Sub
    End If
    If Len(TextBox1) = 2 Then TextBox1 = TextBox1 & ":"
    Set nesne = Nothing
End Sub
C++:
Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Dim OldTimeValue As String, FormattedTimeValue As String
    OldTimeValue = TextBox1.Text
    FormattedTimeValue = SaatFormatDuzenle(OldTimeValue)
    If FormattedTimeValue = "" Then
        TextBox1 = ""
    Else
        TextBox1.Text = FormattedTimeValue
        'Me.DurusSuresiHesapla
    End If
End Sub
C++:
Function SaatFormatDuzenle(ByVal TimeValueStringFormat As String) As String
    On Error Resume Next
    Dim NewDateValue As Date
    NewDateValue = TimeValue(TimeValueStringFormat)
    If Err.Number = 0 Then
        SaatFormatDuzenle = Format(NewDateValue, "hh:mm")
    Else
        SaatFormatDuzenle = ""
        Err.Clear
    End If
End Function
 
Üst