textbox enter olayı

[metinozlu]

Merhaba
bildiğiniz gibi textbox a girildiğinde renginin değişmesi için,textbox ın enter olayına kod yazılıyor.çıkış olayınada kod yazarak renk eski haline dönüyor.
bu şekilde bir olay olması için her textbox ın enter ve exit olayına kod yazılması gerekiyor. ancak 100 adet textbox a bu kodları yazmak çok zaman alıyor.
acaba userform üzerindeki herhangi textbox a girince rengini değiştirecek çıkınca eski rengine dönmesini sağlayacak kısa bir kod varmı?

 

[zafer]

Merhaba


Kod:
For i = 1 To 100
Controls("textbox" & i).BackColor = &H80000002
Next i

Controls olarak aratırmısınız daha çok bilgi alabilirsiz


Edit : Cevabımda bütün textboxların zemin rengi değişiyor.

 

[metinozlu]

arama yaptım ancak örnek kodlar textbox olayına yazılmış,bu nedenle soruma cevap vermiyor.
ancak problemin çözüleceğine eminim :hey:

 

[metinozlu]

???

 

[Ali]

Private Sub TextBox1_Enter()
TextBox1.BackColor = &HC0FFFF
End Sub


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

 

[Ali]

Pardon siz tüm textboxlar için istemişsiniz

 

[zafer]

Merhaba

Mouse ile textboxların üzerine dokunduğunuzda sarı olur.

Deneyin işinize yarayacakmı.

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
on error resume next

ad = ActiveControl.Name
CCC = Left(ad, 4)
If CCC = "Text" Then Controls(ad).BackColor = &HC0FFFF
For i = 1 To 100
If Controls("textbox" & i).Name <> ad Then Controls("textbox" & i).BackColor = &H80000005
Next
End Sub

 

[Levent Menteşoğlu]

Sorunuz için class module en ideal çözüm. Ekte bir örnek sunuyorum.

 

[Ali]

Sorunuz için class module en ideal çözüm.

Sayın Levent diğer çözümler sistem kaynaklarını dahamı zorlar.

 

[Levent Menteşoğlu]

Sayın Levent diğer çözümler sistem kaynaklarını dahamı zorlar.

Diğer çözümler derken, benim görebildiğim başka bir çözüm daha olabilir, oda her textboxun hem enter hemde exit olayına kod yazmaktır. Buda 100 adet textbox için 200 kod demektir. Sistem kaynaklarını zorlayacağını sanmıyorum. Sadece fazla kod hafıda da fazla yer işgal edeceği gibi, yazarkende bir hayli sıkıcı olacaktır.

 

[Ali]

Sizin çözümünüz bana daha kullanışlı geldi. Sayenizde farklı yöntemlerde öğreniyoruz. Ellerinize sağlık..

 

[Levent Menteşoğlu]

class module çok az bilinen ama çok kullanışlı bir uygulamadır. Bende bu konu ile çok kısa bir zamandır ilgileniyorum. Gerçi üstadlarımızın özelliklede Sn Haluk beyin bu konuda örnek uygulamaları mevcut. Bende elimden geldiğince bir şeyler öğrenip sizlerle paylaşıyorum.

 

[metinozlu]

sayın leventm cevabınız için çok teşekkür ederim.kodları projemde uyguladım gayet iyi çalışıyor.yüzlerce kişiyi yüzlerce satır kod yazmaktan kurtardınız.herkese büyük zaman tasarrufu sağladınız.Allah(C.C) sizlerden razı olsun.Cevap veren diğer forum üyelerine de teşekkür eder,herkese iyi çalışmalar dilerim.

 

[Levent Menteşoğlu]

Rica ederim. Ayrıca Sn Haluk bey üstadımızın aşağıdaki linkten önerdiği class modül kullanmadan da aynı işlemi api ile gerçekleştiren kodlarıda sizlerle paylaşmak istiyorum. Farklı bir uygulama olması açısından güzel bir örnek.

http://www.mrexcel.com/board2/viewtopic.php?t=166707

UserForm modul kodları:

[vb:1:3ceece54e8]Private Sub UserForm_Activate()
TimerID = SetTimer(0, 0, 1, AddressOf TimerProc)
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
KilltimerAPI 0, TimerID
End Sub
[/vb:1:3ceece54e8]

Standart modul kodları:

[vb:1:3ceece54e8]
Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Declare Function KilltimerAPI Lib "user32" Alias "KillTimer" _
(ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

Public TimerID As Long
Public PreTextBox As String

Sub TimerProc()
On Error Resume Next
With UserForm1
If TypeName(.ActiveControl) = "TextBox" Then
If PreTextBox <> .ActiveControl.Name Then
Call TextBoxExit_Event
KilltimerAPI 0, TimerID
Call TextBoxEnter_Event
TimerID = SetTimer(0, 0, 1, AddressOf TimerProc)
PreTextBox = .ActiveControl.Name
End If
Else
UserForm1.Controls(PreTextBox).BackColor = vbWhite
End If
End With
End Sub

Sub TextBoxEnter_Event()
UserForm1.ActiveControl.BackColor = vbYellow
End Sub

Sub TextBoxExit_Event()
UserForm1.Controls(PreTextBox).BackColor = vbWhite
End Sub
[/vb:1:3ceece54e8]

 

[burhancavus61]

hocam ben bunu uygulamaya çalıştım ama olmadı
kodlarım aşağıdaki gibi

class1
------------------------
Public WithEvents txt As MSForms.TextBox
Private Sub txt_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error Resume Next
UserForm2.Controls("" & [hz1]).BackColor = vbWhite
End Sub
Private Sub txt_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
txt.BackColor = vbYellow
[hz1] = txt.Name
End Sub
Private Sub txt_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
On Error Resume Next
UserForm2.Controls("" & [hz1]).BackColor = vbWhite
End Sub
Private Sub txt_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
txt.BackColor = vbYellow
[hz1] = txt.Name
End Sub


userform2
-----------------
Dim txt() As New Class1
Dim FrmW As Integer, FrmH As Integer
----------------------
Private Sub UserForm_Initialize()
Application.ScreenUpdating = False

ReDim Preserve txt(214)
'On Error Resume Next
For a = 1 To 214
Set txt(a).txt = Controls("textbox" & a)
Next

Dim Ctrl As Control
FrmW = Me.Width
FrmH = Me.Height
With Application
Me.Height = .Height
Me.Width = .Width
Me.Top = .Top
Me.Left = .Left
End With
rfrmw = Me.Width
rfrmh = Me.Height
rfrmw = Me.Width
rfrmh = Me.Height
b = (rfrmw / FrmW) * 100
UserForm2.Zoom = b

Worksheets("gtklf ").Visible = True
Worksheets("biftklf").Visible = True
Worksheets("bfiyat").Visible = True
Worksheets("bmek").Visible = True
Worksheets("isortby").Visible = True
Worksheets("malid").Visible = True
Worksheets("tteknikp").Visible = True
Worksheets("tyapiarac").Visible = True
Worksheets("tyasak").Visible = True
Worksheets("tisdny").Visible = True
Worksheets("ohisby").Visible = True
Worksheets("tadres").Visible = True
Worksheets("tyerli").Visible = True
Worksheets("firma").Visible = True
Worksheets("data").Visible = True
Worksheets("tfesh").Visible = True

Dim m As Integer
For m = 1 To 8
UserForm2.Controls("TextBox" & m).Value = ActiveCell.Offset(0, m).Value
Next m
Application.ScreenUpdating = True

End Sub

textboxlar renklenmedi vede hata verdi
hata mesajı aşağıda
run-time error -2147024809 (80070057)