• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

[Çözüldü] Listbox'tan 5 farklı Veri Alıp 5 Farklı Userforma'a Rastgele Veri Aktarma

B

BedriA

Katılım
3 Haziran 2017
Mesajlar
797
Excel Vers. ve Dili
2007, 32
Arkadaşlar,

Listbox'tan alınacak 5 farklı veriyi, 5 farklı userforma bir buton yardımıyla otomatik aktarmak istiyorum.

5 farklı veriyi sırayla aynı userforma çağırmak da olabilir. İlkinin mümkün olduğunu biliyorum da ikincisini bilmiyorum.

Halit Hoca benzer bir işlev için bir kod yazmıştı ama bir türlü uyarlayamadım.
Örnek dosya ektedir.

Yardımlarınız için teşekkür ederim.

Fikir vermesi açısından, aşağıdaki linktekine benzer bir şey yapmak istiyorum.

http://www.testlericoz.com/testcoz.php?id=4983
 

Ekli dosyalar

Son düzenleme:
Sorunu anlamadığım için cevap yazmamıştım
Alternatif olması için userforma 1 adet SpinButton1 nesnesi ekle ve aşağıdaki kodu userformun içine koy

Kod: 
Private Sub SpinButton1_SpinUp()


If Worksheets("Sayfa1").Cells(Rows.Count, 2).End(3).Row >= SpinButton1 Then
sat = SpinButton1.Value
TextBox1.Text = Worksheets("Sayfa1").Cells(sat, 2).Value
TextBox2.Text = Worksheets("Sayfa1").Cells(sat, 3).Value
TextBox3.Text = Worksheets("Sayfa1").Cells(sat, 4).Value
TextBox4.Text = Worksheets("Sayfa1").Cells(sat, 5).Value
TextBox5.Text = Worksheets("Sayfa1").Cells(sat, 6).Value
TextBox6.Text = Worksheets("Sayfa1").Cells(sat, 7).Value
TextBox7.Text = Worksheets("Sayfa1").Cells(sat, 8).Value

Else
SpinButton1.Value = Worksheets("Sayfa1").Cells(Rows.Count, 2).End(3).Row + 1
MsgBox "en sona geldiniz."
SpinButton1.Value = Worksheets("Sayfa1").Cells(Rows.Count, 2).End(3).Row
End If

If SpinButton1.Value <= 0 Then
SpinButton1.Value = 1
End If

End Sub

Private Sub SpinButton1_SpinDown()

If SpinButton1.Value >= 1 Then
sat = SpinButton1.Value

TextBox1.Text = Worksheets("Sayfa1").Cells(sat, 2).Value
TextBox2.Text = Worksheets("Sayfa1").Cells(sat, 3).Value
TextBox3.Text = Worksheets("Sayfa1").Cells(sat, 4).Value
TextBox4.Text = Worksheets("Sayfa1").Cells(sat, 5).Value
TextBox5.Text = Worksheets("Sayfa1").Cells(sat, 6).Value
TextBox6.Text = Worksheets("Sayfa1").Cells(sat, 7).Value
TextBox7.Text = Worksheets("Sayfa1").Cells(sat, 8).Value

Else
SpinButton1.Value = 1
MsgBox "ilk başa geldiniz."
End If

If SpinButton1.Value <= 0 Then
SpinButton1.Value = 1
End If


End Sub
 
halit3' Alıntı:
Sorunu anlamadığım için cevap yazmamıştım
Alternatif olması için userforma 1 adet SpinButton1 nesnesi ekle ve aşağıdaki kodu userformun içine koy

Kod: 
Private Sub SpinButton1_SpinUp()


If Worksheets("Sayfa1").Cells(Rows.Count, 2).End(3).Row >= SpinButton1 Then
sat = SpinButton1.Value
TextBox1.Text = Worksheets("Sayfa1").Cells(sat, 2).Value
TextBox2.Text = Worksheets("Sayfa1").Cells(sat, 3).Value
TextBox3.Text = Worksheets("Sayfa1").Cells(sat, 4).Value
TextBox4.Text = Worksheets("Sayfa1").Cells(sat, 5).Value
TextBox5.Text = Worksheets("Sayfa1").Cells(sat, 6).Value
TextBox6.Text = Worksheets("Sayfa1").Cells(sat, 7).Value
TextBox7.Text = Worksheets("Sayfa1").Cells(sat, 8).Value

Else
SpinButton1.Value = Worksheets("Sayfa1").Cells(Rows.Count, 2).End(3).Row + 1
MsgBox "en sona geldiniz."
SpinButton1.Value = Worksheets("Sayfa1").Cells(Rows.Count, 2).End(3).Row
End If

If SpinButton1.Value <= 0 Then
SpinButton1.Value = 1
End If

End Sub

Private Sub SpinButton1_SpinDown()

If SpinButton1.Value >= 1 Then
sat = SpinButton1.Value

TextBox1.Text = Worksheets("Sayfa1").Cells(sat, 2).Value
TextBox2.Text = Worksheets("Sayfa1").Cells(sat, 3).Value
TextBox3.Text = Worksheets("Sayfa1").Cells(sat, 4).Value
TextBox4.Text = Worksheets("Sayfa1").Cells(sat, 5).Value
TextBox5.Text = Worksheets("Sayfa1").Cells(sat, 6).Value
TextBox6.Text = Worksheets("Sayfa1").Cells(sat, 7).Value
TextBox7.Text = Worksheets("Sayfa1").Cells(sat, 8).Value

Else
SpinButton1.Value = 1
MsgBox "ilk başa geldiniz."
End If

If SpinButton1.Value <= 0 Then
SpinButton1.Value = 1
End If


End Sub
Genişletmek için tıkla ...

İşte şimdi sorun esaslı bir şekilde çözüldü.
Çok sağolun Halit hocam.

Aynı işlev için ilk kod arayışımda "Bu kadar form gereksiz" demiştiniz, haklı olduğunuzu şimdi anladım.

Selam ve saygılarımla.
 
Bu gif dosyayı izle yükleniyor sanırım böyle bir şey yapmak istiyorsunuz.

 
halit3' Alıntı:
Bu gif dosyayı izle yükleniyor sanırım böyle bir şey yapmak istiyorsunuz.

Genişletmek için tıkla ...

Benimkinde, bunun yanı sıra, birkaç güzel özellik daha var ve görsel olarak daha iyi hazırlanmış, diyebilirim.

Paylaştığınız çalışmayı dosya olarak temin etmek mümkün mü acaba?
 
halit3' Alıntı:
Aşağıdaki linkdeki 9 nolu mesaja bak

http://www.excel.web.tr/f126/soru-bankasy-ve-testi-t107493.html#post894422
Genişletmek için tıkla ...


Halit Hocam,

Çok teşekkür ederim.

Son verdiğiniz kodda, başlık satırını da soru olarak getiriyor. Başlığı silince sorunda düzeldi. Başlığı silemeden kodda değişiklik yapmak mümkün mü? Kodun çalışmama uyarladığım şekli aşağıdadır.

Bu arada benim yaptığım çalışma, öğretmenlerin kullanmasına dönük... Söz konusu kodla ilgili özellikle öğretmen, akıllı tahta ile
optik form dağıtmak suretiyle sınav yapabilecek. Hatta şu Kim Milyoner Olmak İster programında, seyircilerin sorulara cevap verdiği
aparat ile optik form da kullanmaya gerek kalmayabilir. Tabi bu kısım şimdilik fantezi...

Kod: 
Private Sub SpinButton1_SpinUp()


If Worksheets("Suz1").Cells(Rows.Count, 2).End(3).Row >= SpinButton1 Then
sat = SpinButton1.Value 
Label38.Caption = Worksheets("Suz1").Cells(sat, 2).Value
Label39.Caption = Worksheets("Suz1").Cells(sat, 3).Value
Label40.Caption = Worksheets("Suz1").Cells(sat, 4).Value
Label41.Caption = Worksheets("Suz1").Cells(sat, 5).Value
Label42.Caption = Worksheets("Suz1").Cells(sat, 6).Value
Label43.Caption = Worksheets("Suz1").Cells(sat, 7).Value
Label44.Caption = Worksheets("Suz1").Cells(sat, 8).Value

Else
SpinButton1.Value = Worksheets("Suz1").Cells(Rows.Count, 2).End(3).Row + 1
MsgBox ComboBox1.Value & " konusunun son sorusuna geldiniz."
SpinButton1.Value = Worksheets("Suz1").Cells(Rows.Count, 2).End(3).Row
End If

If SpinButton1.Value <= 0 Then
SpinButton1.Value = 1
End If

End Sub

Private Sub SpinButton1_SpinDown()

If SpinButton1.Value >= 1 Then
sat = SpinButton1.Value

Label38.Caption = Worksheets("Suz1").Cells(sat, 2).Value
Label39.Caption = Worksheets("Suz1").Cells(sat, 3).Value
Label40.Caption = Worksheets("Suz1").Cells(sat, 4).Value
Label41.Caption = Worksheets("Suz1").Cells(sat, 5).Value
Label42.Caption = Worksheets("Suz1").Cells(sat, 6).Value
Label43.Caption = Worksheets("Suz1").Cells(sat, 7).Value
Label44.Caption = Worksheets("Suz1").Cells(sat, 8).Value

Else
SpinButton1.Value = 1
MsgBox ComboBox1.Value & " konusunun ilk sorusuna geldiniz."
End If

If SpinButton1.Value <= 0 Then
SpinButton1.Value = 1
End If
End Sub
 
Son düzenleme:
kod :

Kod: 
Private Sub SpinButton1_SpinUp()

If Worksheets("Sayfa1").Cells(Rows.Count, 2).End(3).Row >= SpinButton1 Then
sat = SpinButton1.Value
TextBox1.Text = Worksheets("Sayfa1").Cells(sat, 2).Value
TextBox2.Text = Worksheets("Sayfa1").Cells(sat, 3).Value
TextBox3.Text = Worksheets("Sayfa1").Cells(sat, 4).Value
TextBox4.Text = Worksheets("Sayfa1").Cells(sat, 5).Value
TextBox5.Text = Worksheets("Sayfa1").Cells(sat, 6).Value
TextBox6.Text = Worksheets("Sayfa1").Cells(sat, 7).Value
TextBox7.Text = Worksheets("Sayfa1").Cells(sat, 8).Value

Else
SpinButton1.Value = Worksheets("Sayfa1").Cells(Rows.Count, 2).End(3).Row + 1
MsgBox "en sona geldiniz."
SpinButton1.Value = Worksheets("Sayfa1").Cells(Rows.Count, 2).End(3).Row
End If

If SpinButton1.Value <= 0 Then
SpinButton1.Value = 1
End If

End Sub

Private Sub SpinButton1_SpinDown()

If SpinButton1.Value >= 2 Then
sat = SpinButton1.Value

TextBox1.Text = Worksheets("Sayfa1").Cells(sat, 2).Value
TextBox2.Text = Worksheets("Sayfa1").Cells(sat, 3).Value
TextBox3.Text = Worksheets("Sayfa1").Cells(sat, 4).Value
TextBox4.Text = Worksheets("Sayfa1").Cells(sat, 5).Value
TextBox5.Text = Worksheets("Sayfa1").Cells(sat, 6).Value
TextBox6.Text = Worksheets("Sayfa1").Cells(sat, 7).Value
TextBox7.Text = Worksheets("Sayfa1").Cells(sat, 8).Value

Else
SpinButton1.Value = 2
MsgBox "ilk başa geldiniz."
End If

If SpinButton1.Value <= 0 Then
SpinButton1.Value = 2
End If


End Sub


Private Sub UserForm_Initialize()
SpinButton1.Value = 1
End Sub
 
halit3' Alıntı:
kod :

Kod: 
Private Sub SpinButton1_SpinUp()

If Worksheets("Sayfa1").Cells(Rows.Count, 2).End(3).Row >= SpinButton1 Then
sat = SpinButton1.Value
TextBox1.Text = Worksheets("Sayfa1").Cells(sat, 2).Value
TextBox2.Text = Worksheets("Sayfa1").Cells(sat, 3).Value
TextBox3.Text = Worksheets("Sayfa1").Cells(sat, 4).Value
TextBox4.Text = Worksheets("Sayfa1").Cells(sat, 5).Value
TextBox5.Text = Worksheets("Sayfa1").Cells(sat, 6).Value
TextBox6.Text = Worksheets("Sayfa1").Cells(sat, 7).Value
TextBox7.Text = Worksheets("Sayfa1").Cells(sat, 8).Value

Else
SpinButton1.Value = Worksheets("Sayfa1").Cells(Rows.Count, 2).End(3).Row + 1
MsgBox "en sona geldiniz."
SpinButton1.Value = Worksheets("Sayfa1").Cells(Rows.Count, 2).End(3).Row
End If

If SpinButton1.Value <= 0 Then
SpinButton1.Value = 1
End If

End Sub

Private Sub SpinButton1_SpinDown()

If SpinButton1.Value >= 2 Then
sat = SpinButton1.Value

TextBox1.Text = Worksheets("Sayfa1").Cells(sat, 2).Value
TextBox2.Text = Worksheets("Sayfa1").Cells(sat, 3).Value
TextBox3.Text = Worksheets("Sayfa1").Cells(sat, 4).Value
TextBox4.Text = Worksheets("Sayfa1").Cells(sat, 5).Value
TextBox5.Text = Worksheets("Sayfa1").Cells(sat, 6).Value
TextBox6.Text = Worksheets("Sayfa1").Cells(sat, 7).Value
TextBox7.Text = Worksheets("Sayfa1").Cells(sat, 8).Value

Else
SpinButton1.Value = 2
MsgBox "ilk başa geldiniz."
End If

If SpinButton1.Value <= 0 Then
SpinButton1.Value = 2
End If


End Sub


Private Sub UserForm_Initialize()
SpinButton1.Value = 1
End Sub
Genişletmek için tıkla ...

Teşekkür ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst