• DİKKAT

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

Combobox çağırdığım kod labelde gözüksün ve textbox çıksın

Katılım
18 Ekim 2006
Mesajlar
87
Excel Vers. ve Dili
2000, ENG
Arkadaşlar,

Lütfen biri bana yardım etsin, saatlerdir arıyorum forumu ama sorunuma hiçbir çözüm bulamadım.

Sorunum Combobox'tan çağırdığım bir kod Labelde tüm hücreleriyle gözüksün sonrada labelde çıkan tüm kodlar için Adet ve Fiyat girilmek üzere textboxlar açılsın. Ancak bu bayilerin kayıtları standart değil, her bayinin satışı farklı oluyor.

Kitaplardan forumdan aradım aradım ama bir sonuç bulamadım.
Şimdiden çok çok teşekkür ederim.

Dosya ektedir. Bişiler yapmaya çalıştım ama başaramadım. Dosyanın içinde sorunu daha detaylı anlattım.
 
Textbox çıkarma konusunu bilmiyorum.Ama Bir listbox koyup listboxta listeleyebilirsiniz.
Sonrada listboxa tıklayıp verileri daha önceden koyduğunuz textboxlara aktarabilirsiniz.:cool:
 
Selamlar,

Size Evren beyinde belirttiği tarzda bir örnek dosya hazırladım. Dosyayı açıp formu çalıştırın. ComboBoxtan ürün kodu seçin. Seçilen ürün ListBoxta listelenecektir. (ListBoxtan çoklu seçim yapabilirsiniz.) Yandaki TextBoxlara adet ve fiyatı girip kaydet tuşuna bastığınızda ilgili kayıtlara girdiğiniz değerler yazılacaktır.
 
Merhaba,
Sn. Evren Gizlen ve Korhan Ayhan Hocalarıma saygılarımla.
Ben de şöyle bir şey hazırladım. Umarım işinize yarar.
Kolay gelsin.
 
Son düzenleme:
Çok çok teşekkür ederim hepinize ama işime hiç yaramıyor.

Sevgili Korhan Ayhan,

Sizin örnek.xls dosyasını inceledim combobox ve listbox istediğim gibi çalışıyor ama ben label'da görüp textboxları da labeldaki ürünlere göre çıkartmayı istiyorum. 1000 nolu dükkanda 5 kayıt varsa 5 textbox 20 kayıt varsa 20 textbox açılsın.

Çok çok teşekkür ederim. Ellerinize sağlık.

Sevgili Meslan,

Sizinde göndermiş olduğunuz dosyayı inceledim. Benim istediğim textboxların adet ve fiyat boşken çıkması.

Teşekkür ederim ellerinize sağlık.
 
Sn. ipkisiyamaksosis,
Gerekli düzenlemeyi yaptım. Dosyayı tekrar incelyebilirsiniz.
 
Ekteki örneği inceleyiniz. Grupta ne kadar eleman varsa, o kadar Label ve TextBox, çalışma zamanında oluşur.

Formunuzda daha önceden varolan iki Label silindi ve yerine bir adet Frame nesnesi yerleştirildi. Kodlama aşağıdaki gibidir.

NOT : Örnek dosyayı inceleyiniz.

Kod:
Private Sub ComboBox1_Change()
    Dim SatirSay As Integer
    Dim y As Integer
    Dim ctrl As Control
    
    Frame1.Controls.Clear
    
    With Sheets("Sheet1")
        For i = 2 To .Cells(65536, 1).End(xlUp).Row
            If CStr(.Cells(i, 1)) = ComboBox1 Then
                SatirSay = SatirSay + 1
            End If
        Next i
        If SatirSay > 0 Then
            Call Tablo_Olustur(SatirSay)
        End If
    
        For i = 2 To .Cells(65536, 1).End(xlUp).Row
            If CStr(.Cells(i, 1)) = ComboBox1 Then
                y = y + 1
                Me.Controls("LblKod" & y).Caption = .Cells(i, 2)
                Me.Controls("LblKtg" & y).Caption = .Cells(i, 3)
            End If
        Next i
    End With
        
        
End Sub
Private Sub Tablo_Olustur(ByRef Olusturulacak_Satir_Sayisi As Integer)
    Dim txT As MSForms.TextBox
    Dim lbL As MSForms.Label
    Dim ustKod As Double
    Dim ustKtg As Double
    Dim ustMik As Double
    Dim ustFyt As Double
    Dim soL As Double
    Dim yuK As Double
    Dim geN As Double
    
    ustMik = 2: ustFyt = 2: ustKod = 2: ustKtg = 2: soL = 2: yuK = 18: geN = 72
    
    With Frame1
        For i = 1 To Olusturulacak_Satir_Sayisi
            
            Set lbL = .Controls.Add("Forms.Label.1", "LblKod" & i, True)
            With lbL
                .Caption = "LblKod" & i
                .Top = ustKod + 4
                .Left = soL
                .Height = yuK
                .Width = geN
                ustKod = ustKod + .Height + 1
                soL = soL + geN + 1
            End With
            
            Set lbL = .Controls.Add("Forms.Label.1", "LblKtg" & i, True)
            With lbL
                .Caption = "LblKtg" & i
                .Top = ustKtg + 4
                .Left = soL ' + geN + 1
                .Height = yuK
                .Width = geN
                ustKtg = ustKtg + .Height + 1
                soL = soL + geN + 1
            End With
            
            Set txT = .Controls.Add("Forms.TextBox.1", "TxtMiktar" & i, True)
            With txT
                .Top = ustMik
                .Left = soL ' + geN + 1
                .Height = yuK
                .Width = geN
                ustMik = ustMik + .Height + 1
                soL = soL + geN + 1
            
            End With
            
            Set txT = .Controls.Add("Forms.TextBox.1", "TxtFiyat" & i, True)
            With txT
                .Top = ustFyt
                .Left = soL ' + geN + 1
                .Height = yuK
                .Width = geN
                ustFyt = ustFyt + .Height + 1
                soL = soL + geN + 1
            
            End With
            soL = 2
        Next i
        
        .ScrollBars = fmScrollBarsVertical
        .ScrollHeight = (i - 1) * (19) + 4
    
    End With
End Sub
 
Sayın Ferhat Pazarçevirdi,

Öncelikle belirtmek isterim ki tam istediğim gibi olmuş ben ufak değişiklikler yaptım sadece. Ancak son bir sorum olacak.

Ben bir tane CommanButton ekledim bu butonu kayıt için kullnacağım. Yani girilen adet ve fiyatları o bayii için sheet2 yada sheet1 e kaydetmem gerekiyor. Denemedim ama frame i hiç kullanmadığım için çözemedim. Forum da da frame le ilgili beni aydınlatacak birşey bulamadım.

Yardım ederseniz çok sevinirim.

Yardımlarınız için sonsuz teşekkür ederim. Ellerinize sağlık

Ayrıca diğer arkadaşlar sizlerede verdiğiniz emekten ötürü çok çok teşekkür ederim.
 
Kaydetme işlemi için, kodlarınızın son hali şu şekilde olmalı... Daha önceki verdiğim kodlara ilaveler, kırmızı ile gösterilmiştir.

Kaydet işlemi gerçekleştirecek button ismi CommanButton1 ve kayıt sayfası Sheet1 olarak kabul edilmiştir.

Kod:
[COLOR=red]Dim arr() As Long[/COLOR] [COLOR=darkgreen]'Userform Kod modülünün en üst satırında bulunmalı[/COLOR]
[COLOR=darkgreen]'-------------------------------------------------[/COLOR]
[COLOR=red]Private Sub CommandButton1_Click()[/COLOR]
 
[COLOR=red]  Dim ctrl As Control[/COLOR]
[COLOR=red]  Dim mk&, fy&[/COLOR]
 
[COLOR=red]  With Sheets("Sheet1")[/COLOR]
[COLOR=red]      For Each ctrl In Frame1.Controls[/COLOR]
[COLOR=red]          If Left(ctrl.Name, 9) = "TxtMiktar" Then[/COLOR]
[COLOR=red]              mk = mk + 1[/COLOR]
[COLOR=red]              If IsNumeric(ctrl) Then .Cells(arr(mk), 4) = CDbl(ctrl)[/COLOR]
[COLOR=red]          ElseIf Left(ctrl.Name, 8) = "TxtFiyat" Then[/COLOR]
[COLOR=red]              fy = fy + 1[/COLOR]
[COLOR=red]              If IsNumeric(ctrl) Then .Cells(arr(fy), 5) = CDbl(ctrl)[/COLOR]
[COLOR=red]          End If[/COLOR]
[COLOR=red]      Next[/COLOR]
[COLOR=red]  End With[/COLOR]
[COLOR=red]End Sub[/COLOR]
[COLOR=darkgreen]'---------------------------------[/COLOR]
 
Private Sub ComboBox1_Change()
    Dim SatirSay As Integer
    Dim y As Integer
    Dim i As Integer
    Dim ctrl As Control
 
    Frame1.Controls.Clear
 
    With Sheets("Sheet1")
        For i = 2 To .Cells(65536, 1).End(xlUp).Row
            If CStr(.Cells(i, 1)) = ComboBox1 Then
                SatirSay = SatirSay + 1
[COLOR=red]              ReDim Preserve arr(1 To SatirSay)[/COLOR]
[COLOR=red]              arr(SatirSay) = i[/COLOR]
            End If
        Next i
        If SatirSay > 0 Then
            Call Tablo_Olustur(SatirSay)
        End If
 
        For i = 2 To .Cells(65536, 1).End(xlUp).Row
            If CStr(.Cells(i, 1)) = ComboBox1 Then
                y = y + 1
                Me.Controls("LblKod" & y).Caption = .Cells(i, 2)
                Me.Controls("LblKtg" & y).Caption = .Cells(i, 3)
            End If
        Next i
    End With
End Sub
[COLOR=darkgreen]'-----------------------------------------------[/COLOR]
 
Private Sub Tablo_Olustur(ByRef Olusturulacak_Satir_Sayisi As Integer)
    Dim txT As MSForms.TextBox
    Dim lbL As MSForms.Label
    Dim ustKod As Double
    Dim ustKtg As Double
    Dim ustMik As Double
    Dim ustFyt As Double
    Dim soL As Double
    Dim yuK As Double
    Dim geN As Double
 
    ustMik = 2: ustFyt = 2: ustKod = 2: ustKtg = 2: soL = 2: yuK = 18: geN = 72
 
    With Frame1
        For i = 1 To Olusturulacak_Satir_Sayisi
 
            Set lbL = .Controls.Add("Forms.Label.1", "LblKod" & i, True)
            With lbL
                .Caption = "LblKod" & i
                .Top = ustKod + 4
                .Left = soL
                .Height = yuK
                .Width = geN
                ustKod = ustKod + .Height + 1
                soL = soL + geN + 1
            End With
 
            Set lbL = .Controls.Add("Forms.Label.1", "LblKtg" & i, True)
            With lbL
                .Caption = "LblKtg" & i
                .Top = ustKtg + 4
                .Left = soL ' + geN + 1
                .Height = yuK
                .Width = geN
                ustKtg = ustKtg + .Height + 1
                soL = soL + geN + 1
            End With
 
            Set txT = .Controls.Add("Forms.TextBox.1", "TxtMiktar" & i, True)
            With txT
                .Top = ustMik
                .Left = soL ' + geN + 1
                .Height = yuK
                .Width = geN
                ustMik = ustMik + .Height + 1
                soL = soL + geN + 1
 
            End With
 
            Set txT = .Controls.Add("Forms.TextBox.1", "TxtFiyat" & i, True)
            With txT
                .Top = ustFyt
                .Left = soL ' + geN + 1
                .Height = yuK
                .Width = geN
                ustFyt = ustFyt + .Height + 1
                soL = soL + geN + 1
 
            End With
            soL = 2
        Next i
 
        .ScrollBars = fmScrollBarsVertical
        .ScrollHeight = (i - 1) * (19) + 4
 
    End With
End Sub
 
Son düzenleme:
Merhabalar,

Sheet1'de Stok yazan yere Var yada Yok yazdırmak istiyorum. Ancak makro'da If Isnumeric yazdığı için sadece rakam girebiliyorum sabahtan beri araştırıyorum nasıl Text girdirebilirim diye ama bir türlü bulamadım.

Bana yardımcı olursanız çok sevinirim. Teşekkürler...

Private Sub CommandButton1_Click()

Dim ctrl As Control
Dim mk&, fy&, st&

With Sheets("Sheet1")
For Each ctrl In Frame1.Controls
If Left(ctrl.Name, 9) = "TxtMiktar" Then
mk = mk + 1
If IsNumeric(ctrl) Then .Cells(arr(mk), 5) = CDbl(ctrl)
ElseIf Left(ctrl.Name, 8) = "TxtFiyat" Then
fy = fy + 1
If IsNumeric(ctrl) Then .Cells(arr(fy), 6) = CDbl(ctrl)
ElseIf Left(ctrl.Name, 7) = "TxtStok" Then
st = st + 1
If IsNumeric(ctrl) Then .Cells(arr(st), 4) = CDbl(ctrl)
End If
Next
End With
 

Ekli dosyalar

Geri
Üst