Select Case Döngüsü

[ahmed_ummu]

Günaydın arkadaşlar.

Ekte gönderdiğim örnek dosyada herhangi bir textbox'a DbClick yapınca hemen üzerine bir frame açılıyor. Ve bu farmede aşağıdaki isimlerde 4 Adet Label var.
Rapor
Yıllık İzin
Mazeret İzni
Devamsız

Rapor isimli Label'e tıklandığnda aktif Texxbox'a "R" yazması ve Frame nin Visible özelliğinin False olması gerekiyor.
Yıllık İzin isimli Label'e tıklandığnda aktif Texxbox'a "Yİ" yazması ve Frame nin Visible özelliğinin False olması gerekiyor.
Mazeret İzni İzin isimli Label'e tıklandığnda aktif Texxbox'a "Mİ" yazması ve Frame nin Visible özelliğinin False olması gerekiyor.
Devamsız isimli Label'e tıklandığnda aktif Texxbox'a "D" yazması ve Frame nin Visible özelliğinin False olması gerekiyor.

Select Case ile yaptım ama çalışmıyor. Nerede hata var yardımcı olabilir misiniz.

 

[veyselemre]

Userformdaki bütün kodları silin.
Class1 modulu ekleyip aşağıdaki kodları yerleştirin.

Option Explicit

Public WithEvents TextGroup As MSForms.TextBox

Private Sub TextGroup_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    With UserForm1.Frame1
        .Visible = True
        .Left = TextGroup.Left
        .Top = TextGroup.Top - .Height
        .Tag = TextGroup.Name
    End With
End Sub

Userform1 kod kısmına aşağıdaki kodları ekleyin.

Dim textBoxes(1 To 31) As New Class1

Private Sub UserForm_Initialize()
    Frame1.Visible = False
    Dim intTextBox As Integer
    For intTextBox = 1 To 31
        Set textBoxes(intTextBox).TextGroup = Controls("TextBox" & intTextBox)
    Next intTextBox
End Sub

Private Sub Label1_Click()
    Frame1.Visible = False
    Controls(Frame1.Tag).Value = "R"
End Sub

Private Sub Label2_Click()
    Frame1.Visible = False
    Controls(Frame1.Tag).Value = "Yİ"
End Sub

Private Sub Label3_Click()
    Frame1.Visible = False
    Controls(Frame1.Tag).Value = "Mİ"
End Sub

Private Sub Label4_Click()
    Frame1.Visible = False
    Controls(Frame1.Tag).Value = "D"
End Sub

 

[ahmed_ummu]

Userformdaki bütün kodları silin.
Class1 modulu ekleyip aşağıdaki kodları yerleştirin.

Option Explicit

Public WithEvents TextGroup As MSForms.TextBox

Private Sub TextGroup_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    With UserForm1.Frame1
        .Visible = True
        .Left = TextGroup.Left
        .Top = TextGroup.Top - .Height
        .Tag = TextGroup.Name
    End With
End Sub

Userform1 kod kısmına aşağıdaki kodları ekleyin.

Dim textBoxes(1 To 31) As New Class1

Private Sub UserForm_Initialize()
    Frame1.Visible = False
    Dim intTextBox As Integer
    For intTextBox = 1 To 31
        Set textBoxes(intTextBox).TextGroup = Controls("TextBox" & intTextBox)
    Next intTextBox
End Sub

Private Sub Label1_Click()
    Frame1.Visible = False
    Controls(Frame1.Tag).Value = "R"
End Sub

Private Sub Label2_Click()
    Frame1.Visible = False
    Controls(Frame1.Tag).Value = "Yİ"
End Sub

Private Sub Label3_Click()
    Frame1.Visible = False
    Controls(Frame1.Tag).Value = "Mİ"
End Sub

Private Sub Label4_Click()
    Frame1.Visible = False
    Controls(Frame1.Tag).Value = "D"
End Sub

Çok teşekkür ederim Veysel Emre bey. Sorunsuz çalışıyor.

 

[ahmed_ummu]

Userformdaki bütün kodları silin.
Class1 modulu ekleyip aşağıdaki kodları yerleştirin.

Option Explicit

Public WithEvents TextGroup As MSForms.TextBox

Private Sub TextGroup_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    With UserForm1.Frame1
        .Visible = True
        .Left = TextGroup.Left
        .Top = TextGroup.Top - .Height
        .Tag = TextGroup.Name
    End With
End Sub

Userform1 kod kısmına aşağıdaki kodları ekleyin.

Dim textBoxes(1 To 31) As New Class1

Private Sub UserForm_Initialize()
    Frame1.Visible = False
    Dim intTextBox As Integer
    For intTextBox = 1 To 31
        Set textBoxes(intTextBox).TextGroup = Controls("TextBox" & intTextBox)
    Next intTextBox
End Sub

Private Sub Label1_Click()
    Frame1.Visible = False
    Controls(Frame1.Tag).Value = "R"
End Sub

Private Sub Label2_Click()
    Frame1.Visible = False
    Controls(Frame1.Tag).Value = "Yİ"
End Sub

Private Sub Label3_Click()
    Frame1.Visible = False
    Controls(Frame1.Tag).Value = "Mİ"
End Sub

Private Sub Label4_Click()
    Frame1.Visible = False
    Controls(Frame1.Tag).Value = "D"
End Sub

erhaba Veysel Emre bey.

Label için de böyle bir işlem yapacak olursak. Label'e tek tıklama yapınca

General Yordamına "Public WithEvents LabelGroup As MSForms.Label"

Formun kod kısmına "Dim Label(5 To 35) As New Class1"

ve İnitialize yordamına

Private Sub LabelGroup_Click(ByVal Cancel As MSForms.ReturnBoolean)
With UserForm1.Frame1
LabelGroup.Backcolor=VbWhite
End With
End Sub

Label'in Click yordamına

Controls(Frame1.Tag).BackColor = vbWhite yazmak gerekiyor. Veya ayrı bir Class modülü mü açmak gerekiyor.

 

[veyselemre]

Bütün kodları silin.
Label1-4 isimlerini Label101-104 yapın.

Label5-35 olan label isimlerini Label1-Label31 yapın texboxlar gibi.

Class1 module kodları;

Option Explicit
Public renk
Public WithEvents TextGroup As MSForms.TextBox
Public WithEvents LabelGroup As MSForms.Label
Public WithEvents LabelGroup2 As MSForms.Label

Private Sub Class_Initialize()
    renk = UserForm1.BackColor
End Sub

Private Sub LabelGroup_Click()
    LabelGroup.BackColor = IIf(LabelGroup.BackColor = vbWhite, renk, vbWhite)
End Sub

Private Sub LabelGroup2_Click()
    With UserForm1.Frame1
        .Visible = False
    End With
    Call UserForm1.calis(LabelGroup2.Tag)
End Sub

Private Sub TextGroup_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    With UserForm1.Frame1
        .Visible = True
        .Left = TextGroup.Left
        .Top = TextGroup.Top - .Height
        .Tag = TextGroup.Name
    End With
End Sub

Userform1 kodları;

Dim textBoxes(1 To 31) As New Class1
Dim labels(1 To 31) As New Class1
Dim labels2(101 To 104) As New Class1

Private Sub UserForm_Initialize()
    Frame1.Visible = False
    Dim say As Integer
    
    For say = 1 To 31
        Set textBoxes(say).TextGroup = Controls("TextBox" & say)
        Set labels(say).LabelGroup = Controls("Label" & say)
    Next say
    
    For say = 101 To 104
        Set labels2(say).LabelGroup2 = Controls("Label" & say)
    Next say
    Label101.Tag = "R"
    Label102.Tag = "Yİ"
    Label103.Tag = "Mİ"
    Label104.Tag = "D"
End Sub

Public Sub calis(izin)
    Frame1.Visible = False
    Controls(Frame1.Tag) = izin
End Sub

 

[ahmed_ummu]

Bütün kodları silin.
Label1-4 isimlerini Label101-104 yapın.

Label5-35 olan label isimlerini Label1-Label31 yapın texboxlar gibi.

Class1 module kodları;

Option Explicit
Public renk
Public WithEvents TextGroup As MSForms.TextBox
Public WithEvents LabelGroup As MSForms.Label
Public WithEvents LabelGroup2 As MSForms.Label

Private Sub Class_Initialize()
    renk = UserForm1.BackColor
End Sub

Private Sub LabelGroup_Click()
    LabelGroup.BackColor = IIf(LabelGroup.BackColor = vbWhite, renk, vbWhite)
End Sub

Private Sub LabelGroup2_Click()
    With UserForm1.Frame1
        .Visible = False
    End With
    Call UserForm1.calis(LabelGroup2.Tag)
End Sub

Private Sub TextGroup_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    With UserForm1.Frame1
        .Visible = True
        .Left = TextGroup.Left
        .Top = TextGroup.Top - .Height
        .Tag = TextGroup.Name
    End With
End Sub

Userform1 kodları;

Dim textBoxes(1 To 31) As New Class1
Dim labels(1 To 31) As New Class1
Dim labels2(101 To 104) As New Class1

Private Sub UserForm_Initialize()
    Frame1.Visible = False
    Dim say As Integer
   
    For say = 1 To 31
        Set textBoxes(say).TextGroup = Controls("TextBox" & say)
        Set labels(say).LabelGroup = Controls("Label" & say)
    Next say
   
    For say = 101 To 104
        Set labels2(say).LabelGroup2 = Controls("Label" & say)
    Next say
    Label101.Tag = "R"
    Label102.Tag = "Yİ"
    Label103.Tag = "Mİ"
    Label104.Tag = "D"
End Sub

Public Sub calis(izin)
    Frame1.Visible = False
    Controls(Frame1.Tag) = izin
End Sub

Çok çok teşekkürler Veysel Emre bey.