• DİKKAT

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

Çoklu CheckBox lar ile veri aktarmak

ulutanas

Altın Üye
Katılım
8 Kasım 2008
Mesajlar
582
Excel Vers. ve Dili
Excel Vers. ve Dili Ofis 2021 TR 32 Bit
Arkadaşlar merhaba, yine depo stok programı ile ilgili bir şeyler yapmaya çalışıyorum genel olarak bütün sorunları çözdüm ama takıldığım bir konu var stok girişi yapıyorum ve aynı form içerisinde oda içerisinde paletlerin yerleşimi ile ilgili bir şeyler denedim CheckBox lar ekledim her hangi bir CheckBox ı seçtiğimde DEPO_PLANI sayfasında ki belirlediğimi hücreye o paletin numarasını aktarıyorum.

Sorun burada başlıyor. Depoya yaklaşık 2000 palet yerleşim noktası bulunmakta aşağıdaki kodlar ile her bir CheckBox için çözüm sağlanabiliyor ama ben 5 tanesi için yaptığımda aklıma geldi aynı kodlardan 2000 ad. eklersem sanırım form kitlenir diye düşündüm.

Konu ile ilgili, bütün CheckBox lara içeren bir kod ile yine yerlerini ayrı ayrı bildirmek üzere ayarlaması yapılabilir mi?


Kod:
Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
    TextBox8.Value = CheckBox1.Caption
    Else
    TextBox8.Value = ""
    
End If
If CheckBox1.Value = True Then
Sheets("DEPO_PLANI").Range("B3") = TextBox3.Value
Else
Sheets("DEPO_PLANI").Range("B3") = TextBox3.Value
Sheets("DEPO_PLANI").Range("B3") = ""
End If
End Sub

Private Sub CheckBox2_Click()
If CheckBox2.Value = True Then
    TextBox8.Value = CheckBox2.Caption
    Else
    TextBox8.Value = ""
    
End If
If CheckBox2.Value = True Then
Sheets("DEPO_PLANI").Range("C3") = TextBox3.Value
Else
Sheets("DEPO_PLANI").Range("C3") = TextBox3.Value
Sheets("DEPO_PLANI").Range("C3") = ""
End If
End Sub

Private Sub CheckBox3_Click()
If CheckBox3.Value = True Then
    TextBox8.Value = CheckBox3.Caption
    Else
    TextBox8.Value = ""
    
End If
If CheckBox3.Value = True Then
Sheets("DEPO_PLANI").Range("D3") = TextBox3.Value
Else
Sheets("DEPO_PLANI").Range("D3") = TextBox3.Value
Sheets("DEPO_PLANI").Range("D3") = ""
End If
End Sub
Private Sub CheckBox4_Click()
If CheckBox4.Value = True Then
    TextBox8.Value = CheckBox4.Caption
    Else
    TextBox8.Value = ""
    
End If
If CheckBox4.Value = True Then
Sheets("DEPO_PLANI").Range("E3") = TextBox3.Value
Else
Sheets("DEPO_PLANI").Range("E3") = TextBox3.Value
Sheets("DEPO_PLANI").Range("E3") = ""
End If
End Sub

Private Sub CheckBox5_Click()
If CheckBox5.Value = True Then
    TextBox8.Value = CheckBox5.Caption
    Else
    TextBox8.Value = ""
    
End If
If CheckBox5.Value = True Then
Sheets("DEPO_PLANI").Range("F3") = TextBox3.Value
Else
Sheets("DEPO_PLANI").Range("F3") = TextBox3.Value
Sheets("DEPO_PLANI").Range("F3") = ""
End If
End Sub

Yardımlarınız için şimdiden teşekkür ederim.
İyi çalışmalar,
Saygılarımla...
 
Merhaba.
Kodlar aşağıdaki gibi kısaltılabilir.

Her ChkBox aynı işlemi yaptığı için aşağıdaki kod aktarımı gerçekleştirecek.
Kod:
Sub NumaraAktar(chk As CheckBox, Hucre As String)
    Sheets("DEPO_PLANI").Range("B3") = TextBox3.Value
    If chk.Value = True Then
        TextBox8.Value = chk.Caption
    Else
        TextBox8.Value = ""
        Sheets("DEPO_PLANI").Range(Hucre) = ""
    End If
End Sub

CheckBox ların kodları da aşağıdaki gibi olacak.

Kod:
Private Sub CheckBox1_Change()
    NumaraAktar CheckBox1, "B3"
End Sub

Private Sub CheckBox2_Change()
    NumaraAktar CheckBox1, "C3"
End Sub

Private Sub CheckBox3_Change()
    NumaraAktar CheckBox1, "D3"
End Sub

Öneri:
2000 tane CheckBox eklemektense onun yerine ListBox ekleseniz palet isimlerini alfabetik listeleseniz ve ListBox a çift tıklama ile aktarma yapsanız daha kolay olmaz mı?

2000 tane CheckBox yerine bir 2000 satırlı bir ListBox daha kullanışlı olmaz mı?

Örnek dosyanızı eklerseniz belki farklı bir çözüm yolu daha bulunabilir.
 
Konu ile ilgili, bütün CheckBox lara içeren bir kod ile yine yerlerini ayrı ayrı bildirmek üzere ayarlaması yapılabilir mi?

Class Modül kullanabilirsiniz. Ekte geçmişte hazırladığım sayfa üzerindeki uygulamalar için olanı inceleyebilirsiniz. Benzer mantığı userform üzerinde de uygulayabilirsiniz.
 

Ekli dosyalar

Son düzenleme:
Bütün hocalarım ilginiz için çok teşekkür ederim.

Tavsiyeleriniz benim için çok önemli bütün tavsiyelerinizi dün akşamdan başlayarak araştırdım.

En son çözüm için dosya ekleyerek konuya daha kolay yardımcı olacağınızı düşündüm.

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

Ekli dosyalar

Arkadaşlar tekrar merhaba, konu güncel devam ediyor.
 
Geri
Üst