Soru tek texbox ile makro çalışmıyor

bycakir

Altın Üye
Katılım
1 Aralık 2017
Mesajlar
220
Excel Vers. ve Dili
Microsoft Office 365 ProPlus
Altın Üyelik Bitiş Tarihi
18-01-2025
merhaba arkadaşlar. az bilgim ile biraz karısık bir makro yazdım. fakat texbox1 tek ikem makro çalışmıyor. 2. texbox u eklediğimde makro calısıyor. barkod okuyucu kullanıyorum.
tek texbox ile bu makroyu çalıştırabilirmiyiz?

Kod:
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim sh, sh1 As Worksheet
Set sh = ThisWorkbook.Sheets("Sayfa1")
Set sh1 = ThisWorkbook.Sheets("Sayfa2")
son1 = sh1.Cells(Rows.Count, "A").End(3).Row
son2 = sh.Cells(Rows.Count, "A").End(3).Row
Lk1.Caption = ""
Lk2.Caption = ""

For i = 2 To son2

If TextBox1.Text = sh.Range("A" & i) Then

lbl3.Caption = sh.Range("B" & i)
lbl4.Caption = sh.Range("C" & i)
GoSub ekle
End If
Next
ekle:
For p = 2 To son1
If TextBox1.Text = sh1.Range("A" & p) Then

MsgBox "DAHA ÖNCE KAYDI YAPILDI..." & vbCrLf & " " & vbCrLf & "EXCELL SIRA NO" & " " & p, vbInformation, "..::Ömür ÇAKIR::.."
TextBox1.Text = ""
TextBox2.Text = ""
lbl3.Caption = ""
lbl4.Caption = ""
Lk1.Caption = ""
Exit Sub
End If
Next

If TextBox1.Text = "" Then
TextBox2.Text = ""
Exit Sub
Else

If lbl3.Caption = "" Then
TextBox1.Text = ""
TextBox2.Text = ""
lbl3.Caption = ""
lbl4.Caption = ""
Lk1.Caption = ""

MsgBox "LİSTEDE KAYDI YOK...", vbInformation, "..::Ömür ÇAKIR::.."
     
Exit Sub
Else
sh1.Range("A" & son1 + 1) = TextBox1.Text
sh1.Range("B" & son1 + 1) = lbl3.Caption
sh1.Range("C" & son1 + 1) = lbl4.Caption
sh1.Range("D" & son1 + 1) = Format(Now, "dd.mm.yyyy hh:mm")

Lk1.Caption = "KAYDEDİLDİ"

temiz:
TextBox1.Text = ""
TextBox2.Text = ""
lbl3.Caption = ""
lbl4.Caption = ""

End If
End If
ActiveWorkbook.Save

End Sub
 

Ekli dosyalar

  • 100.4 KB Görüntüleme: 5
Son düzenleme:

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,598
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Örnek dosya ekleyebilir misiniz.
 

bycakir

Altın Üye
Katılım
1 Aralık 2017
Mesajlar
220
Excel Vers. ve Dili
Microsoft Office 365 ProPlus
Altın Üyelik Bitiş Tarihi
18-01-2025
başlıga ekledim.
 

AdemCan

Altın Üye
Destek Ekibi
Katılım
1 Eylül 2008
Mesajlar
1,362
Excel Vers. ve Dili
2019 TR
Merhaba, TextBox1_Exit bölümünde kodun çalışması için imlecin textboxtan çıkması gerekir.
Tab tuşu ile textboxtan çıkış yapmak istediğinizde label nesnesi seçilmediği için imleç textboxta kalır ve kod çalışmaz.
 

bycakir

Altın Üye
Katılım
1 Aralık 2017
Mesajlar
220
Excel Vers. ve Dili
Microsoft Office 365 ProPlus
Altın Üyelik Bitiş Tarihi
18-01-2025
bunu tek kutu ile çalıştırmanın yolu yokmudur. ben 2. tex boxu ekledim. barkod okuyucu kullanıyoruz. amacım exele bakmadan seri olarak barkod okuyucu ile surekli ilerlemek. mevcut durumda basa dönmek için barkodu her seferinde 2 kez okutmam gerekiyor. bunu teke duşurmek iştiyorum.
 

AdemCan

Altın Üye
Destek Ekibi
Katılım
1 Eylül 2008
Mesajlar
1,362
Excel Vers. ve Dili
2019 TR
Örnek dosyada Sicil numaralarının uzunluğu 5
Standart hepsi 5 karakter ise TextBox1_Change kodlarını kullanabilirsiniz.
Kod:
Private Sub TextBox1_Change()
If Len(TextBox1.Value) = 5 Then
    Dim sh, sh1 As Worksheet
    Set sh = ThisWorkbook.Sheets("Sayfa1")
    Set sh1 = ThisWorkbook.Sheets("Sayfa2")
    son1 = sh1.Cells(Rows.Count, "A").End(3).Row
    son2 = sh.Cells(Rows.Count, "A").End(3).Row
    Lk1.Caption = ""
    Lk2.Caption = ""
    
    For i = 2 To son2
    
    If TextBox1.Text = sh.Range("A" & i) Then
    
    lbl3.Caption = sh.Range("B" & i)
    lbl4.Caption = sh.Range("C" & i)
    GoSub ekle
    End If
    Next
ekle:
    For p = 2 To son1
    If TextBox1.Text = sh1.Range("A" & p) Then
    
    MsgBox "DAHA ÖNCE KAYDI YAPILDI..." & vbCrLf & " " & vbCrLf & "EXCELL SIRA NO" & " " & p, vbInformation, "..::Ömür ÇAKIR::.."
    TextBox1.Text = ""
    TextBox2.Text = ""
    lbl3.Caption = ""
    lbl4.Caption = ""
    Lk1.Caption = ""
    Exit Sub
    End If
    Next
    
    If TextBox1.Text = "" Then
    TextBox2.Text = ""
    Exit Sub
    Else
    
    If lbl3.Caption = "" Then
    TextBox1.Text = ""
    TextBox2.Text = ""
    lbl3.Caption = ""
    lbl4.Caption = ""
    Lk1.Caption = ""
    
    MsgBox "LİSTEDE KAYDI YOK...", vbInformation, "..::Ömür ÇAKIR::.."
          
    Exit Sub
    Else
    sh1.Range("A" & son1 + 1) = TextBox1.Text
    sh1.Range("B" & son1 + 1) = lbl3.Caption
    sh1.Range("C" & son1 + 1) = lbl4.Caption
    sh1.Range("D" & son1 + 1) = Format(Now, "dd.mm.yyyy hh:mm")
    
    Lk1.Caption = "KAYDEDİLDİ"
    
temiz:
    TextBox1.Text = ""
    TextBox2.Text = ""
    lbl3.Caption = ""
    lbl4.Caption = ""
    
    End If
    End If
End If
ActiveWorkbook.Save

TextBox1.SetFocus
End Sub
 
Üst