UserForm' da bir kodun tüm textbox' lara uygulanması

[tamer42]

Merhabalar,
Bir Userform' da 40 civarında TextBox mevcut, aşağıdaki kodları tüm textbox' lara yazmak yerine; tek bir defada yazarak bütün TextBox' lara uygulanmasını nasıl sağlayabiliriz?

Private Sub TextBox1_Enter()
TextBox1.BackColor = RGB(200, 220, 255)
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1.BackColor = vbWhite
End Sub

 

[Haluk]

Linkteki gibi Class Module kullanın....

Çok fazla TextBox a rakam girmeyi zorlama

Selamlar. Private Sub TextBox1_Change() Say = Len(TextBox1) - Len(Replace(TextBox1, ",", "")) If Say > 1 Then SendKeys "{BS}" If Left(TextBox1, 1) = "," Then TextBox1 = "0," End Sub Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Select Case KeyAscii...

www.excel.web.tr

.

 

[Mahmut Bayram]

Ekteki örneği inceleyiniz.

 

[Mahmut Bayram]

Linkteki gibi Class Module kullanın....

Çok fazla TextBox a rakam girmeyi zorlama

Selamlar. Private Sub TextBox1_Change() Say = Len(TextBox1) - Len(Replace(TextBox1, ",", "")) If Say > 1 Then SendKeys "{BS}" If Left(TextBox1, 1) = "," Then TextBox1 = "0," End Sub Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Select Case KeyAscii...

www.excel.web.tr

.

Haluk bey, kusura bakmayın görmemişim.

 

[tamer42]

Ekteki örneği inceleyiniz.

Linkteki gibi Class Module kullanın....

Çok fazla TextBox a rakam girmeyi zorlama

Selamlar. Private Sub TextBox1_Change() Say = Len(TextBox1) - Len(Replace(TextBox1, ",", "")) If Say > 1 Then SendKeys "{BS}" If Left(TextBox1, 1) = "," Then TextBox1 = "0," End Sub Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Select Case KeyAscii...

www.excel.web.tr

.

Sn Haluk Hocam verdiğiniz linkteki örneklere Class Module aşağıdaki kodu yazdım, olmadı.

örnek üzerinde düzenleyebilirmisiniz,
Çok Teşekkürler,

Private Sub txt_Enter()
txt.BackColor = RGB(200, 220, 255)
End Sub

 

[tamer42]

Ekteki örneği inceleyiniz.

Sn Mahmut Hocam kodlar burada güzel çalışıyor, yalnız benim Userformda Multipage var, Multipage sayfalarındaki TextBox' ta çalışmadı.

iyi Çalışmalar.

 

[Zeki Gürsoy]

Sn Haluk Hocam verdiğiniz linkteki örneklere Class Module aşağıdaki kodu yazdım, olmadı.

örnek üzerinde düzenleyebilirmisiniz,
Çok Teşekkürler,

Private Sub txt_Enter()
txt.BackColor = RGB(200, 220, 255)
End Sub

Class module ile TextBox Enter veya Exit olayları görünmez olduğundan bu olaylar kullanılamaz.
İnternette bu problem için önerilen en ideal çözüm olarak sonsuz döngü (Do-Loop) önerilmiş. Ancak bu da Excel uygulamasının CPU kullanımını %20 civarına çıkarır.

Bu problemi çözmenin en iyi yolu, Windows pencere mesajlarını dinleyerek renklendirmektir. Bununla ilgili örnek ekleyeceğim.

.

 

[Haluk]

Hmmmm....... Class Module TextBox'larda Enter ve Exit olaylarını desteklemiyor.....

İşinize yararsa, aşağıdakileri deneyin;

UserForm modülü:

Private Sub UserForm_Initialize()
    Dim i As Byte
    
    For Each MyCtrl In Me.Controls
        If TypeName(MyCtrl) = "TextBox" Then
            i = i + 1
            ReDim Preserve TxtBx(i)
            Set TxtBx(i).txt = MyCtrl
        End If
    Next
End Sub

Class1 Modülü:

Public WithEvents txt As MSForms.TextBox
'
Private Sub txt_Change()
    txt.BackColor = RGB(200, 220, 255)
End Sub
'
Private Sub txt_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    txt.BackColor = vbWhite
End Sub

.

 

[tamer42]

Hmmmm....... Class Module TextBox'larda Enter ve Exit olaylarını desteklemiyor.....

İşinize yararsa, aşağıdakileri deneyin;

UserForm modülü:

Dim TxtBx() As New Class1
'
Private Sub UserForm_Initialize()
    Dim i As Byte
   
    For Each MyCtrl In Me.Controls
        If TypeName(MyCtrl) = "TextBox" Then
            i = i + 1
            ReDim Preserve TxtBx(i)
            Set TxtBx(i).txt = MyCtrl
            i = i + 1
        End If
    Next
End Sub

Class1 Modülü:

Public WithEvents txt As MSForms.TextBox
'
Private Sub txt_Change()
    txt.BackColor = RGB(200, 220, 255)
End Sub
'
Private Sub txt_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    txt.BackColor = vbWhite
End Sub

.

Haluk Hocam teşekkürler,
tam olmasa da 70-80% işe yarıyor,

iyi çalışmalar.

 

[Haluk]

100 % için Zeki Beyi beklemek lazım, herhalde ...

.

 

[tamer42]

100 % için Zeki Beyi beklemek lazım, herhalde ...

.

Zeki Beyi bekleyebiliriz,
Aslında Mahmut Bayram hocamın verdiği örnekte; kodları MultiPage' e uygulayabilsek sıkıntı büyük ölçüde çözülecek gibi duruyor.

rnk = True
Do While rnk
   DoEvents
   If Not Ctrl Is Me.ActiveControl Then
      txtcolor vbWhite
      Set Ctrl = Me.ActiveControl
      txtcolor RGB(200, 220, 255)
      End If
   Loop

 

[Haluk]

O zaman; @Mahmut Bayram 'ın izniyle, kendisinin verdiği kodu revize edersek şimdilik işinizi görür....

Dim Ctrl As MSForms.Control, rnk As Boolean
'
Private Sub UserForm_Activate()
    rnk = True
    Do While rnk
        DoEvents
        If Not Ctrl Is Me.MultiPage1.Pages(Me.MultiPage1.Value).ActiveControl Then
              txtcolor vbWhite
              Set Ctrl = Me.MultiPage1.Pages(Me.MultiPage1.Value).ActiveControl
              txtcolor RGB(200, 220, 255)
        End If
    Loop
End Sub
'
Private Sub txtcolor(renk As Long)
    If Ctrl Is Nothing Then Exit Sub
    If TypeName(Ctrl) <> "TextBox" Then Exit Sub
    Ctrl.Object.BackColor = renk
End Sub
'
Private Sub UserForm_Terminate()
    End
End Sub

.

 

[tamer42]

O zaman; @Mahmut Bayram 'ın izniyle, kendisinin verdiği kodu revize edersek şimdilik işinizi görür....

Dim Ctrl As MSForms.Control, rnk As Boolean
'
Private Sub UserForm_Activate()
    rnk = True
    Do While rnk
        DoEvents
        If Not Ctrl Is Me.MultiPage1.Pages(Me.MultiPage1.Value).ActiveControl Then
              txtcolor vbWhite
              Set Ctrl = Me.MultiPage1.Pages(Me.MultiPage1.Value).ActiveControl
              txtcolor RGB(200, 220, 255)
        End If
    Loop
End Sub
'
Private Sub txtcolor(renk As Long)
    If Ctrl Is Nothing Then Exit Sub
    If TypeName(Ctrl) <> "TextBox" Then Exit Sub
    Ctrl.Object.BackColor = renk
End Sub
'
Private Sub UserForm_Terminate()
    End
End Sub

.

Sn Haluk Hocam çok teşekkürler,
aynı durumu ComboBox için de yapmak için nasıl bir düzenleme yapılabilir?

iyi çalışmalar.

 

[Haluk]

Eskisinin yerine, aşağıdakini kullanın...

Private Sub txtcolor(renk As Long)
    If Ctrl Is Nothing Then Exit Sub
    If TypeName(Ctrl) <> "TextBox" And TypeName(Ctrl) <> "ComboBox" Then Exit Sub
    Ctrl.Object.BackColor = renk
End Sub

.

 

[tamer42]

Eskisinin yerine, aşağıdakini kullanın...

Private Sub txtcolor(renk As Long)
    If Ctrl Is Nothing Then Exit Sub
    If TypeName(Ctrl) <> "TextBox" And TypeName(Ctrl) <> "ComboBox" Then Exit Sub
    Ctrl.Object.BackColor = renk
End Sub

.

Sn Haluk hocam çok teşekkür ederim.

 

[tamer42]

Hmmmm....... Class Module TextBox'larda Enter ve Exit olaylarını desteklemiyor.....

İşinize yararsa, aşağıdakileri deneyin;
Class1 Modülü:

Public WithEvents txt As MSForms.TextBox
'
Private Sub txt_Change()
    txt.BackColor = RGB(200, 220, 255)
End Sub
'
Private Sub txt_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    txt.BackColor = vbWhite
End Sub

.

Haluk Hocam merhaba,
Ekli görselde görüleceği üzere Userformda 15 satır , 8 Sutundan oluşan Textbox dizisi mevcut, mouse Bu textbox' ların herhangi birinin üzerine geldiği zaman onun arka planın kırmızı' ya boyamasını istiyordum.
ilk başta mouse başka textbox' a geçince bir öncekinin rengi de kırmızı kaldığı için Class Moduşe içine aşağıdaki kod dizisini oluşturudum.
Aslında bu kod dizisi çalışıyor, yalnız biraz hantal oldu, yavaş çalışıyor.
Bunu daha hızlandırmanın yada pratik bir yöntemi olur mu?

ilginiz için şimdiden teşekkürler,

iyi pazarlar.

Public WithEvents TxtGrp As MSForms.TextBox
 
Private Sub TxtGrp_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
   Dim strLB As String
   
   strLB = TxtGrp.Name
    
   If TxtGrp = "" Then Exit Sub
   
      Call txtMouseDown(strLB)
   
    TxtGrp.BackColor = vbRed
    TxtGrp.ForeColor = vbWhite
    TxtGrp.Font.Bold = True
         
End Sub

Private Sub txtMouseDown(LbName As String)
Dim myCtrl As MSForms.Control
    
    For Each myCtrl In frmSiparisIE24.Controls
        If TypeName(myCtrl) = "TextBox" Then
            If Left(myCtrl.Name, 5) = "TxtBx" Then
                If LCase(myCtrl.Name) Like "*sevk*" Then
                    If myCtrl.BackColor = vbRed Then
                        If myCtrl.Name <> LbName Then
                    
                            myCtrl.ForeColor = vbBlack
                            myCtrl.Font.Bold = False
                            myCtrl.BackColor = vbWhite

                        End If
                    End If
                End If
            End If
            
        End If
    Next

End Sub