Soru döngü ile textboxlarda çift tık işlemi yapma

[sirkülasyon]

Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If TextBox1.Value = "" Then
TextBox1.Value = "D"
ElseIf TextBox1.Value = "D" Then
TextBox1.Value = "İ"
ElseIf TextBox1.Value = "İ" Then
TextBox1.Value = "R"
Else
TextBox1.Value = "D"
End If
End Sub

Yukarıda ki kod tek textbox için işlem yapıyor. Bu durumu döngüye bağlayarak 1 - 31 textbox için kullanılabilir mi?
Yardımcı olabilir misiniz?

 

[ÖmerBey]

Merhaba,
Aşağıdaki şekilde deneyiniz...

For a = 1 To 31
    Set tb = Me.Controls("TextBox" & a)
    If tb.Value = "" Then
        tb.Value = "D"
    ElseIf tb.Value = "D" Then
        tb.Value = "İ"
    ElseIf tb.Value = "İ" Then
        tb.Value = "R"
    Else
        tb.Value = "D"
    End If
Next

 

[Orion1]

Foruımda class module diye arama yapınız.

 

[ÖmerBey]

Soruya tekrar baktım da sanırım ben yanlış anlamışım. Siz iyisimi Evren Bey'in dediğini yapın.
Mesela şurada çok güzel bir kaynak var.

 

[Zeki Gürsoy]

Bu konuda çokca yazıldı. Biraz farklı bir yöntem için ekli örneği inceleyin...

Örnek dosya : TextBox Implements

UserForm1.frm:

Implements CommonTextBox

'*******************'
'*** Zeki Gürsoy ***'
'***  01/12/2020 ***'
'*******************'
Private TxtCol As TxtCollection

Private Sub CommonTextBox_DblClick(ByVal Cancel As MSForms.IReturnBoolean, ByVal CurrentTextBox As MSForms.IMdcText)
  
    MsgBox "'" & CurrentTextBox.Name & "' çift tıklandı."
  
    Select Case CurrentTextBox.Name
        Case "TextBox1"
            'Yapılması istenenler...
        Case "TextBox2"
            'Yapılması istenenler...
        Case "TextBox3"
            'Yapılması istenenler...
    End Select
End Sub

Private Sub UserForm_Activate()
    Set TxtCol = New TxtCollection
  
    For Each ctrl In Me.Controls
        If TypeOf ctrl Is MSForms.TextBox Then TxtCol.Add ctrl, Me
    Next
  
End Sub

CommonTextBox.cls:

Private WithEvents NewTextBox As MSForms.TextBox

Private handler As CommonTextBox

Friend Sub SetTxt(ByVal vNewValue As MSForms.TextBox, ByVal h As CommonTextBox)
    Set NewTextBox = vNewValue
    Set handler = h
End Sub

Private Sub NewTextBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call handler.DblClick(Cancel, NewTextBox)
End Sub

Public Sub DblClick(ByVal Cancel As MSForms.ReturnBoolean, ByVal CurrentTextBox As MSForms.TextBox)
    'Boş kalacak...
End Sub

TxtCollection.cls:

Private col As Collection

Public Sub Add(ByVal Txt As MSForms.TextBox, ByVal frm As UserForm)
    Dim ct As New CommonTextBox
    ct.SetTxt Txt, frm
    col.Add ct, Txt.Name
End Sub

Public Sub Remove(ByVal Txt As MSForms.TextBox)
    col.Remove Txt.Name
End Sub

Private Sub Class_Initialize()
    Set col = New Collection
End Sub

.

 

[sirkülasyon]

Nur üstüne nur yağmış. Emeği geçenlerin hepsine ayrı ayrı teşekkür ederim. Hepinizden Allah razı olsun.

 

[alicimri]

Alternatif:
Bir Textbox'ı seçin formda boş bir alana tıklayın

Private Sub UserForm_Click()
If ActiveControl.Value = "" Then
ActiveControl.Value = "D"
ElseIf ActiveControl.Value = "D" Then
ActiveControl.Value = "S"
ElseIf ActiveControl.Value = "S" Then
ActiveControl.Value = "Y"
ElseIf ActiveControl.Value = "Y" Then
ActiveControl.Value = ""
End If
End Sub