[ÇÖZÜLDÜ] UserFormda; CheckBox ve TextBox Kontrollerini kısaltmak.

[ECYavuz]

Değerli arkadaşlar;

UserForm Üzerinde 7 Adet CheckBox (CheckBox1...CheckBox7) ve bunlarla bağlantılı çalışan 7 Adet TextBox (TextBox9....TextBox15) bulunmaktadır.

CheckBox_Click yapıldığında gerçekleşen işlemler ve TextBox_Change olduğunda gerçekleşen işlemler aşağıdaki gibidir. Bu seri aşağıdaki örnekde sadece iki grup görüldüğü gibi alt alta devam ediyor.

Bu aynı işlemleri, Control veya Class Modül kullanarak daha kısa bir hale getirebilirmiyiz.

Kod:
Private Sub CheckBox1_Click()
If CheckBox1 Then
TextBox9.Visible = True
TextBox9.Value = 1
Else
TextBox9.Text = Empty
TextBox9.Visible = False
End If
End Sub
'
Private Sub TextBox9_Change()
If TextBox9 = "" Then Exit Sub
deg = Mid(TextBox9.Value, Len(TextBox9.Value), 1)
If IsNumeric(deg) = False Then
TextBox9 = Mid(TextBox9.Value, 1, Len(TextBox9.Value) - 1)
End If
If TextBox9.Value > 3 Then TextBox9.Value = 3
End Sub

Kod:
Private Sub CheckBox2_Click()
If CheckBox2 Then
TextBox10.Visible = True
TextBox10.Value = 1
Else
TextBox10.Text = Empty
TextBox10.Visible = False
End If
End Sub
'
Private Sub TextBox10_Change()
If TextBox10 = "" Then Exit Sub
deg = Mid(TextBox10.Value, Len(TextBox10.Value), 1)
If IsNumeric(deg) = False Then
TextBox10 = Mid(TextBox10.Value, 1, Len(TextBox10.Value) - 1)
End If
If TextBox10.Value > 3 Then TextBox10.Value = 3
End Sub

Saygılarımla...

 

[Ferhat Pazarçevirdi]

Userformunuzun üzerinde -ben örnek olsun diye söylüyorum- belirttiğiniz miktarda, TextBox ve ChckBox olsun. Bu durumda, dediğiniz işlemi yapabilmek için, projenize bir adet Class module (Class1) ekleyin.

Aşağıdaki kodları Class1'e aktarın

Option Explicit
Public WithEvents chkBox As MSForms.CheckBox
Public WithEvents txtBox As MSForms.TextBox
'----------------------------
Private Sub chkBox_Click()
    Dim idx As String
    idx = CLng(Replace(chkBox.Name, "CheckBox", ""))
    With UserForm1.Controls("TextBox" & idx + 8)
        If chkBox Then .Text = 1 Else .Text = Empty
        .Visible = chkBox.Value
    End With
End Sub
'-------------------------
Private Sub txtBox_Change()
    Dim deg
    If Len(txtBox) = 0 Then: Exit Sub
    deg = Mid(txtBox.Value, Len(txtBox.Value), 1)
    If Not IsNumeric(deg) Then
        txtBox = Mid(txtBox.Value, 1, Len(txtBox.Value) - 1)
    End If
    If txtBox.Value > 3 Then txtBox.Value = 3
End Sub

Userform'un Kod bölümüne de, aşağıdakileri aktarın.

Option Explicit
Dim ChkBoxlar() As New Class1
Dim txtBoxlar() As New Class1
Private Sub UserForm_Initialize()
    Dim Ctrl As Control
    Dim i As Integer
    Dim j As Integer
    For Each Ctrl In UserForm1.Controls
        If TypeOf Ctrl Is MSForms.CheckBox Then
            Select Case CLng(Replace(Ctrl.Name, "CheckBox", ""))
                Case 1 To 7
                    i = i + 1
                    ReDim Preserve ChkBoxlar(1 To i)
                    Set ChkBoxlar(i).chkBox = Ctrl
            End Select
        ElseIf TypeOf Ctrl Is MSForms.TextBox Then
            Select Case CLng(Replace(Ctrl.Name, "TextBox", ""))
                Case 9 To 15
                    j = j + 1
                    ReDim Preserve txtBoxlar(1 To j)
                    Set txtBoxlar(j).txtBox = Ctrl
            End Select
        End If
    Next
End Sub

Ekteki dosyayı da inceleyebilirsiniz.

 

[ECYavuz]

Ferhat bey tam istediğim gibi bir kodlama yapmışsınız. Bilginize sağlık, teşekkürler..

 

[hsayar]

Ferhat hocam örenk biz acemiler içinde epey bilgilendirici, emeğinize sağlık.
Yalnız dikkatimi çeken iki şey oldu;
1) Başlangıçta görünür olan textboxların chek konululup sonra kaldırıldıktan sonra görünmez olması nasıl engellenir?
2) .Text = 1 değeri gelemsi sorunlu mu? enegellenemz mi?

Option Explicit
Public WithEvents chkBox As MSForms.CheckBox
Public WithEvents txtBox As MSForms.TextBox
'----------------------------
Private Sub chkBox_Click()
    Dim idx As String
    idx = CLng(Replace(chkBox.Name, "CheckBox", ""))
    With UserForm1.Controls("TextBox" & idx + 8)
5        If chkBox.Value = True Then .BackColor = vbYellow Else .BackColor = vbWhite
'        If chkBox Then .Text = 1 Else .Text = Empty
'        .Visible = chkBox.Value
    End With
End Sub
'-------------------------
Private Sub txtBox_Change()
    Dim deg
    If Len(txtBox) = 0 Then: Exit Sub
    deg = Mid(txtBox.Value, Len(txtBox.Value), 1)
    If Not IsNumeric(deg) Then
        txtBox = "" ' Mid(txtBox.Value, 1, Len(txtBox.Value) - 1)
    End If
    If txtBox.Value > 3 Then txtBox.Value = 3
End Sub

Soruyu sorduktan sonra çözüm aklıma geldi, arak plan trengini değiştirdim.







Birde Userform Termiante Olayında DiziDeğikenlerinin silinmesi daha iyi olmaz mı?

Private Sub UserForm_Terminate()
101 Erase ChkBoxlar, txtBoxlar
End Sub

 

[Ferhat Pazarçevirdi]

Birde Userform Termiante Olayında DiziDeğikenlerinin silinmesi daha iyi olmaz mı?

Class'ın Terminate olayı bu iş için programlanabilir. Class nesneleri, bellekten temizlemek için, aşağıdaki kodları Class Module ekleyiniz.

Private Sub Class_Terminate()
    Set chkBox = Nothing
    Set txtBox = Nothing
End Sub