Select Case Döngüsü

ahmed_ummu

Altın Üye
Katılım
28 Mart 2011
Mesajlar
731
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Altın Üyelik Bitiş Tarihi
15-10-2026
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.
 

Ekli dosyalar

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,646
Excel Vers. ve Dili
Pro Plus 2021
Userformdaki bütün kodları silin.
Class1 modulu ekleyip aşağıdaki kodları yerleştirin.

Kod:
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.

Kod:
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

Altın Üye
Katılım
28 Mart 2011
Mesajlar
731
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Altın Üyelik Bitiş Tarihi
15-10-2026
Userformdaki bütün kodları silin.
Class1 modulu ekleyip aşağıdaki kodları yerleştirin.

Kod:
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.

Kod:
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

Altın Üye
Katılım
28 Mart 2011
Mesajlar
731
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Altın Üyelik Bitiş Tarihi
15-10-2026
Userformdaki bütün kodları silin.
Class1 modulu ekleyip aşağıdaki kodları yerleştirin.

Kod:
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.

Kod:
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

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,646
Excel Vers. ve Dili
Pro Plus 2021
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ı;
Kod:
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ı;
Kod:
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

Altın Üye
Katılım
28 Mart 2011
Mesajlar
731
Excel Vers. ve Dili
Excel 2010 Professional Plus 64 Bit
Altın Üyelik Bitiş Tarihi
15-10-2026
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ı;
Kod:
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ı;
Kod:
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.
 
Üst