Combobox ta sütun başlıklarını seçme

[oguz demirbas]

ek te bulunan dosyada

1. "konu seç" açılır pencereye tıkladığımda C1 den son sütuna kadar olan başlıları gösterebiliyor muyuz?

teşekkür ederim

 

[Orion1]

dosyanız ektedir.

Private Sub UserForm_Initialize()
Dim i As Integer, sonsut As Integer, sh As Worksheet
Set sh = Sheets("9-A-Görsel")
sonsut = sh.Cells(1, sh.Columns.Count).End(xlToLeft).Column
For i = 3 To sonsut
    cbkonusec.AddItem
    cbkonusec.List(i - 3, 0) = sh.Cells(1, i).Value
Next
End Sub

 

[oguz demirbas]

Çok teşekkür ederim.

 

[veyselemre]

Alternatif olsun;

Private Sub UserForm_Initialize()
        cbkonusec.Column = Range(['9-A-Görsel'!C1], ['9-A-Görsel'!C1].End(2)).Value
End Sub

 

[oguz demirbas]

Çok teşekkür ederim

 

[oguz demirbas]

Tekrar Merhabalar;

Aynı dosya üzerinden 2 sorum olacaktı:

1. sınıf seçimi yaptığımda Listbox1 e tüm sınıf listesini nasıl ekleyebilirim?( son sütündaki konu başlığına kadar ve konu başlıkları halinde)

2 kaydet butonuna tıkladığımda verdiğim notu ilgili öğrenci nosuna ve konuya göre kaydını nasıl yapabilirim?

teşekkür ederim.

 

[oguz demirbas]

Güncel

 

[oguz demirbas]

Üzerinde biraz çalışmayı denedim ama hata alıyorum;

Kod:
Private Sub CommandButton3_Click()
If txtno.Text = "" Then MsgBox "lütfen no giriniz": Exit Sub
If cbsınıfsec2.Text = "" Then MsgBox "Sınıf Seçiniz": Exit Sub
If cbkonusec.Text = "" Then MsgBox "Konu Seçiniz": Exit Sub

'sütunda arama
Dim i As Integer, sonsut As Integer, sh As Worksheet, r As Integer, m As Integer
Set sh = Sheets(cbsınıfsec2.Text)
sonsut = sh.Cells(1, sh.Columns.Count).End(xlToLeft).Column
For i = 3 To sonsut
If StrConv(sonsut, vbUpperCase) = StrConv(cbkonusec.Text, vbUpperCase) Then
sonsut.Select
Cells(2, 40).Value = Selection.Columns.Count 'seçilen hücre toplam sütun sayısı
r = Cells(2, 40).Value
End If
Next
'satırda arama
For Each bul In Sheets(cbsınıfsec2.Text).Range("a1:a" & Sheets(cbsınıfsec2.Text).Range("a655").End(3).Row)
If StrConv(bul, vbUpperCase) = StrConv(ara, vbUpperCase) Then
bul.Select
Cells(2, 41).Value = Selection.Rows.Count 'seçilen hücre toplam sütun sayısı
m = Cells(2, 41).Value
End If
Next

'not kayıt
Cells(r, m).Value = txtnot.Value
End Sub

 

[oguz demirbas]

Güncel

 

[veyselemre]

Dim sh As Worksheet
Private Sub ListBox1_Click()
    txtno = ListBox1.List(ListBox1.ListIndex, 0)
    txtad = ListBox1.List(ListBox1.ListIndex, 1)
End Sub
Private Sub UserForm_Initialize()
    Dim i As Integer, sonSut As Integer
    cbsınıfsec2.ListIndex = 0
End Sub
Private Sub cbsınıfsec2_Change()
    Set sh = Sheets(cbsınıfsec2.Text)
    sh.Select
    cbkonusec.Clear
    For i = 3 To sh.Cells(1, sh.Columns.Count).End(xlToLeft).Column
        cbkonusec.AddItem
        cbkonusec.List(i - 3, 0) = sh.Cells(1, i).Value
    Next
    Call listele
End Sub
Private Sub CommandButton3_Click()
    If txtno.Text = "" Then MsgBox "lütfen no giriniz": Exit Sub
    If cbsınıfsec2.Text = "" Then MsgBox "Sınıf Seçiniz": Exit Sub
    If cbkonusec.Text = "" Then MsgBox "Konu Seçiniz": Exit Sub
    sh.Cells(ListBox1.ListIndex + 1, cbkonusec.ListIndex + 3).Value = txtnot.Value
    MsgBox "Not girişi yapıldı, lütfen kayıt yapmayı unutmayın...", vbCritical
    Call listele
End Sub
Sub listele()
    ListBox1.Clear
    sonSat = sh.Cells(Rows.Count, 1).End(3).Row
    sonSut = sh.Cells(1, sh.Columns.Count).End(xlToLeft).Column
    ListBox1.ColumnCount = sonSut
    ListBox1.List = sh.Range("a1", Cells(sonSat, sonSut)).Value
End Sub

 

[oguz demirbas]

Veysel Bey ilginiz için çok teşekkür ederim.

Tek bir "Metod hatası" alıyorum. o da sınıf sayısını arttırdığımda listbox 1 de hata alıyorum

teşekkür ederim

 

[oguz demirbas]

Veysel Bey;
yukarıda belirtilen sorunu şu şekilde çözmeyi başardım. Kodun başına:
"sh.Select"
ekleme yapınca düzeldi.

kaydet 2 butonuna tıkladığımda listbox1 deki seçimin 1 alta kaymasını nasıl sağlarım?

her defasında listbox tan mouse ile seçip not vermek yerine bu işlemi bir butona eklemek istiyorum.

Tesekkür ederim.

 

[veyselemre]

Private Sub CommandButton3_Click()
    If txtno.Text = "" Then MsgBox "lütfen no giriniz": Exit Sub
    If cbsınıfsec2.Text = "" Then MsgBox "Sınıf Seçiniz": Exit Sub
    If cbkonusec.Text = "" Then MsgBox "Konu Seçiniz": Exit Sub
    sh.Cells(ListBox1.ListIndex + 1, cbkonusec.ListIndex + 3).Value = txtnot.Value
    'MsgBox "Not girişi yapıldı, lütfen kayıt yapmayı unutmayın...", vbCritical
    sira = ListBox1.ListIndex + 1
    Call listele
    If sira < ListBox1.ListCount Then
        ListBox1.ListIndex = sira
    Else
        ListBox1.ListIndex = 1
    End If
End Sub

 

[oguz demirbas]

Veysel Bey teşekkür ederim Kodlar kusursuz çalışıyor.