• DİKKAT

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

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

  • Konbuyu başlatan Konbuyu başlatan bycakir
  • Başlangıç tarihi Başlangıç tarihi
Katılım
1 Aralık 2017
Mesajlar
223
Excel Vers. ve Dili
Microsoft Office 365 ProPlus
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

  • T1.xlsm
    T1.xlsm
    100.4 KB · Görüntüleme: 5
Son düzenleme:
Örnek dosya ekleyebilir misiniz.
 
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.
 
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.
 
Ö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
 
Geri
Üst