combobox2 yeni barkod girişi için seçili kalması

[fedeal]

Private Sub ComboBox2_Change()
On Error Resume Next
S = ComboBox2.ListIndex + 2
'BARKOD
TextBox5 = Cells(S, 2)
'ÜRÜNADI
TextBox8 = Cells(S, 5)
'SATIŞ FİYATI
TextBox2 = Cells(S, 7)
'ADET
TextBox6 = Cells(S, 3)
If Len(ComboBox2) = 13 Then CommandButton10_Click
Set rngTop = Worksheets("SATIŞ").Range("F2:F100")
TextBox9.Value = WorksheetFunction.Sum(rngTop)
Set rngTop = Nothing
End Sub

bu kodla veri aktarımı yaptıktan sonra combobox2 yeni barkod girişi için seçili kalması mümkünmü?yani herseferinde maus kullanmak gerekiyor buda zor oluyor.

 

[hsayar]

Private Sub ComboBox2_Change()
On Error Resume Next
S = ComboBox2.ListIndex + 2
'BARKOD
TextBox5 = Cells(S, 2)
'ÜRÜNADI
TextBox8 = Cells(S, 5)
'SATIŞ FİYATI
TextBox2 = Cells(S, 7)
'ADET
TextBox6 = Cells(S, 3)
If Len(ComboBox2) = 13 Then CommandButton10_Click
Set rngTop = Worksheets("SATIŞ").Range("F2:F100")
TextBox9.Value = WorksheetFunction.Sum(rngTop)
Set rngTop = Nothing
ComboBox2.setfocus
End Sub

deneyiniz.

 

[fedeal]

teşekkürler sayın hsayar

 

[hsayar]

rica ederim

 

[fedeal]

Private Sub TextBox13_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim hcr As Range
Set hcr = Sayfa1.Range("b2:b" & Sayfa1.[b65536].End(3).Row).Find(TextBox13, lookat:=xlWhole)
If Not hcr Is Nothing Then
TextBox5 = hcr.Offset(0, 0)
TextBox8 = hcr.Offset(0, 3)
TextBox6 = hcr.Offset(0, 1)
TextBox2 = hcr.Offset(0, 5)
Else
MsgBox "Girilen bilgi bulunamamıştır.", vbCritical, "UYARI"
End If
Set hcr = Nothing
'toplam_fiyat_hesaplar
On Error Resume Next
deg1 = TextBox2
deg2 = ComboBox1
If TextBox2 = "" Then deg1 = 0
If ComboBox1 = "" Then deg2 = 0
TextBox4 = Replace(deg1 * 1 * deg2 * 1, ".", ",")
'verileri_sayfaya_aktarır
Son_Dolu_Satir = Sheets("SATIŞ").Range("A65536").End(xlUp).Row
Bos_Satir = Son_Dolu_Satir + 1
Sheets("SATIŞ").Range("A" & Bos_Satir).Value = _
Application.WorksheetFunction.Max(Sheets("SATIŞ").Range("A:A")) + 1
Sheets("SATIŞ").Range("E" & Bos_Satir).Value = ComboBox1.Text
Sheets("SATIŞ").Range("B" & Bos_Satir).Value = TextBox5.Text
Sheets("SATIŞ").Range("C" & Bos_Satir).Value = TextBox8.Text
Sheets("SATIŞ").Range("D" & Bos_Satir).Value = TextBox2.Text
Sheets("SATIŞ").Range("F" & Bos_Satir).Value = TextBox4.Text
'textboxa_sayfa_üzerindeki_aralıgı_toplar
Set rngTop = Worksheets("SATIŞ").Range("F2:F100")
TextBox9.Value = WorksheetFunction.Sum(rngTop)
Set rngTop = Nothing
TextBox13 = ""
TextBox13 = SetFocus
End Sub[/QUOTE]

yukardaki koda bu şekil uyarladım ama işlem sonunda textbox13 seçili olmuyor.

 

[hsayar]

....................
TextBox13 = ""
TextBox13.SetFocus
End Sub

 

[hsayar]

kodlarınınızı aşağıdaki gibi düzenledim.

Private Sub TextBox13_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim Csf As Worksheet: Set Csf = Worksheets("SATIŞ")
Dim hcr As Range

Set hcr = Sayfa1.Range("b2:b" & Sayfa1.[b65536].End(3).Row).Find(TextBox13, lookat:=xlWhole)

If Not hcr Is Nothing Then
  TextBox5 = hcr.Offset(0, 0)
  TextBox8 = hcr.Offset(0, 3)
  TextBox6 = hcr.Offset(0, 1)
  TextBox2 = hcr.Offset(0, 5)
Else
  MsgBox "Girilen bilgi bulunamamıştır.", 16, "UYARI"
  Exit Sub      'Eğer Stok kodu(muhtemelen) yoksa prosodürden çıkar.
End If
Set hcr = Nothing
'toplam_fiyat_hesaplar
'On Error Resume Next      'dolayısı ile bu satıra gerek kalmaz. ;)
deg1 = TextBox2
deg2 = ComboBox1
If TextBox2 = "" Then deg1 = 0
If ComboBox1 = "" Then deg2 = 0
TextBox4 = Replace(deg1 * 1 * deg2 * 1, ".", ",")

'verileri_sayfaya_aktarır
With Csf
  Son_Dolu_Satir = .Range("A65536").End(xlUp).Row
  Bos_Satir = Son_Dolu_Satir + 1
  .Range("A" & Bos_Satir).Value = _
  Application.WorksheetFunction.Max(.Range("A:A")) + 1
  .Range("E" & Bos_Satir).Value = ComboBox1.Text
  .Range("B" & Bos_Satir).Value = TextBox5.Text
  .Range("C" & Bos_Satir).Value = TextBox8.Text
  .Range("D" & Bos_Satir).Value = TextBox2.Text
  .Range("F" & Bos_Satir).Value = TextBox4.Text
'textboxa_sayfa_üzerindeki_aralıgı_toplar
  TextBox9.Value = WorksheetFunction.Sum(.Range("F2:F100"))
End With

With TextBox13
  .Text = Empty
  .SetFocus
End With
Set Csf = Nothing
End Sub

 

[fedeal]

bir kez daha teşekkürler sayın hsayar

 

[hsayar]

rica ederim