COMBO BOX

[bekir38]

arkadaşlar merhaba,
bul, sil, değiştir makrolarını kullanarak birşeyler yapmak istedim ama,
combo box seçimi için oluşturduğum listeden atanmasını sağlayamadım.
dosyayı ekte gönderiyorum, yardımcı olursanız sevinirim.

iyi çalışmalar,

 

[damra2005]

vbe şifreli

 

[Mahmut Bayram]

synbekir38,
txtbirim.Value = isimli combox adlarını senin form da olmadığında hata veriyor. Senin BİRİM olarak tanımlı combox'unun ismi Combobox1 dir.
YANİ
txtbirim olarak geçen adları Combobox1 olarak değiştir. sorununu çözüldüğünü göreceksin

 

[veyselemre]

Private Sub combobox1_Change()
'If Worksheets("Veri").Range("J2").Value = "" Then Exit Sub
lider.ComboBox1.RowSource = "VerI!J2:J" & WorksheetFunction.CountA(Worksheets("Veri").Range("J2:J10"))
End Sub
Private Sub cmdbul_Click()
Dim bak As Range
For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000")))
If StrConv(bak.Value, vbUpperCase) = StrConv(cbad.Value, vbUpperCase) Then
bak.Select
txtsira.Value = ActiveCell.Offset(0, -1).Value
txtikamet.Value = ActiveCell.Offset(0, 1).Value
ComboBox1.Value = ActiveCell.Offset(0, 2).Value
txtfiyat.Value = ActiveCell.Offset(0, 3).Value
Exit Sub
End If
Next bak
MsgBox "Aradığınız isimde bir kayıt bulunamadı"
End Sub
Private Sub cmdDegistir_Click()
Dim bos As Range
For Each bos In Range("B2:B" & WorksheetFunction.CountA(Range("B2:B65000")))
If cbad.Value = "" Or bos = "" Or ActiveCell = "" Then
MsgBox "Ã?nce aradığınız veriyi BUL ile bulmalısınız"
Exit Sub
End If
Next bos
If txtsira = "" Or cbad = "" Or txtikamet = "" Or ComboBox1 = "" Or txtfiyat = "" Then
MsgBox "Listeden Bir Malzeme Kodu seçmelisiniz"
Else
ActiveCell = cbad
ActiveCell.Offset(0, 1) = txtikamet
ActiveCell.Offset(0, 2) = ComboBox1
ActiveCell.Offset(0, 3) = txtfiyat
End If
ActiveWorkbook.Save
MsgBox "Verileriniz değiştirildi", , "KAYIT"
cmdtemizle_Click
cbad.RowSource = "Veri!B2:B" & say + 1
txtsira.Value = WorksheetFunction.Count(Range("A1:A65000")) + 1
End Sub
Private Sub cmdEnBas_Click()
txtsira = Cells(2, 1)
cbad = Cells(2, 2)
txtikamet = Cells(2, 3)
ComboBox1 = Cells(2, 4)
txtfiyat = Cells(2, 5)
End Sub
Private Sub cmdEnSon_Click()
Dim say As Integer
say = WorksheetFunction.CountA(Range("A1:A65000"))
txtsira = Cells(say, 1)
cbad = Cells(say, 2)
txtikamet = Cells(say, 3)
ComboBox1 = Cells(say, 4)
txtfiyat = Cells(say, 5)
End Sub
Private Sub cmdGeri_Click()
If txtsira = 1 Then
Exit Sub
Else
txtsira = txtsira - 1
cbad = Cells(txtsira + 1, 2)
txtikamet = Cells(txtsira + 1, 3)
ComboBox1 = Cells(txtsira + 1, 4)
txtfiyat = Cells(txtsira + 1, 5)
End If
End Sub
Private Sub cmdIleri_Click()
Dim say As Integer
say = WorksheetFunction.CountA(Range("A1:A65000"))
If txtsira = say Then
Exit Sub
Else
txtsira = txtsira + 1
cbad = Cells(txtsira + 1, 2)
txtikamet = Cells(txtsira + 1, 3)
ComboBox1 = Cells(txtsira + 1, 4)
txtfiyat = Cells(txtsira + 1, 5)
End If
End Sub
Private Sub cmdkapat_Click()
Unload lider
End Sub
Private Sub cmdkaydet_Click()
Dim bak As Range
Dim say As Integer
For Each bak In Range("A1:A" & WorksheetFunction.CountA(Range("A1:A65000")))
If bak.Value = cbad.Value Then
MsgBox "Bu Kayıt numarası bulundu."
Exit Sub
End If
Next bak
For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000")))
If StrConv(bak.Value, vbUpperCase) = StrConv(cbad.Value, vbUpperCase) Then
MsgBox "Bu kodda bir kaydınız bulundu"
Exit Sub
End If
Next bak

say = WorksheetFunction.CountA(Range("B1:B65000"))
txtsira.Value = say

Cells(say + 1, 1).Value = txtsira.Value
Cells(say + 1, 2).Value = cbad.Value
Cells(say + 1, 3).Value = txtikamet.Value
Cells(say + 1, 4).Value = ComboBox1.Value
Cells(say + 1, 5).Value = txtfiyat.Value

ActiveWorkbook.Save
MsgBox "Verileriniz Kaydedildi", , "KAYIT"
cmdtemizle_Click
cbad.RowSource = "Veri!B2:B" & say + 1
txtsira.Value = WorksheetFunction.Count(Range("A1:A65000")) + 1
End Sub
Private Sub cmdsil_Click()
Dim say As Integer
Dim i As Integer
Dim bos As Range
For Each bos In Range("B2:B" & WorksheetFunction.CountA(Range("B2:B65000")))
If cbad.Value = "" Or bos = "" Or ActiveCell = "" Then
MsgBox "Ã?nce aradığınız veriyi BUL ile bulmalısınız"
Exit Sub
End If
Next bos
Range(ActiveCell.Offset(0, -1).Address & ":" & ActiveCell.Offset(0, 3).Address).Delete Shift:=xlUp
say = WorksheetFunction.CountA(Range("A2:A65000"))
For i = 1 To say
Cells(i + 1, 1) = i
Next i
ActiveWorkbook.Save
MsgBox "Veriniz Silindi", , "KAYIT"
cmdtemizle_Click
cbad.RowSource = "Veri!B2:B" & say + 1
txtsira.Value = WorksheetFunction.Count(Range("A1:A65000")) + 1
End Sub
Private Sub cmdtemizle_Click()
cbad.Value = ""
txtikamet.Value = ""
ComboBox1.Value = ""
txtfiyat.Value = ""
cbad.SetFocus
End Sub
Private Sub txtfiyat_Change()
txtfiyat.Value = Format(txtfiyat, "###,###")
End Sub
Private Sub txtfiyat_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii < Asc(0) Or KeyAscii > Asc(9) Then
KeyAscii = 0
Beep
End If
End Sub
Private Sub UserForm_Initialize()
Dim say As Integer
Sheets("Veri").Select
txtsira.Locked = True
If Range("B2") = "" Then
say = WorksheetFunction.CountA(Range("B1:B65000"))
cbad.RowSource = "Veri!B2:B" & say + 1
Else
say = WorksheetFunction.CountA(Range("B1:B65000"))
cbad.RowSource = "Veri!B2:B" & say
End If
txtsira.Value = say
cbad.SetFocus
End Sub

 

[bekir38]

vba şifresi 1, açmayı unutmuşum,
yukarıda yazan kodları denedim ama olmadı,
formu açmak istediğim de sürekli hata veriyor.

 

[Mahmut Bayram]

syn bekir38, çözümlü örnek ekte

 

[bekir38]

çok teşekkürler,
makro çalışıyor ama benim sıkıntıma çözüm tam bu değildi,
birimi kısmı için açılan combo box aynı zamanda birimleride göstermesi
lazım, yani sarı olan yerler. (kg, adet, metre gibi)
ben hepsini tek tek yazmak yerine oradan seçmek istiyorum.

yardımlarınız için teşekkürler,

 

[bekir38]

arkadaşlar buldum galiba,
ekte gönderiyorum,
rowsource kısmına isim giriliyormuş,
bendeki örnekleri karıştırarak buldum,

teşekkürler arkadaşlar,

 

[Mahmut Bayram]

bulduğunuza sevindim bende tam cevap yazıyordum

 

[Mahmut Bayram]

syn bekir38, özel mesajınızda istemiş olduğunuz çalışmayı buraya alıyorum.

 

[bekir38]

TEÞEKKÜRLER,
TAMAM BÃ?YLE BİR ÞEYDİ,

YARDIMLARINIZ İÇİN TEÞEKKÜRLER,

NOT; BU SİTENİN OLUÞUMUNDA EMEÃİ GEÇENLERE VE SİTEYE DESTEK OLAN HEKESE TEÞEKKÜRLER.

İYİ ÇALIÞMALAR,