Barcode Okutma ve Arşivleme

[o2l3m]

Ean128 barkodu ile veri arşivlemek istiyorum.

Örnek dosya ve açıklamayı ekliyorum. Yardımcı olursanız çok memnun olurum.

Prosesler

1 Textbox 1 e okutuğum barcode metni C Sütununa aktarılacak.
2 B Sütununa o anki tarih saat yazılacak
3 C Sütunundaki metin birinci yıldıza kadar D sütununa
4 Birinci yıldız ile İkinci yıldız arası E sütununa
5 İkinci yıldız sonrası F sütununa aktarılacak
6 Hatalı okutmaya karşı C sütunundaki mükerrer kayıtlar anlık silecek
7 Textbox 1 boşaltılacak

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Private Sub TextBox1_Change()
    If Len(TextBox1) = 29 Then
        If WorksheetFunction.CountIf(Range("C:C"), TextBox1.Value) > 0 Then
            TextBox1.Value = Empty
            Exit Sub
        Else
            Satir = Cells(Rows.Count, 2).End(3).Row + 1
            Cells(Satir, 2) = Now
            Cells(Satir, 3) = TextBox1.Value
            If InStr(1, TextBox1.Value, "*") > 0 Then
                Cells(Satir, 4) = Split(TextBox1.Value, "*")(0)
                Cells(Satir, 5) = Split(TextBox1.Value, "*")(1)
                Cells(Satir, 6) = Split(TextBox1.Value, "*")(2)
            End If
            TextBox1.Value = Empty
        End If
    End If
End Sub

 

[o2l3m]

Korhan Bey
Tam istediğim gibi olmuş. Elinize kolunuza sağlık. Çok işimi görecek.

 

[o2l3m]

Korhan Bey

Tarih yanına vardiya sütunu açsak. Vardiyayı Tarih formatındaki saat verisinden otomatik oluşturabilirmiyiz?

00:00-08:00 = 1.Vardiya
08:00-16:00 = 2.Vardiya
16:00-00:00 = 3.Vardiya

şeklinde mesela?

 

[o2l3m]

Cevap verebilecek yok mu acaba?

 

[Ömer BARAN]

Merhaba.

Umarım yanılmıyorum.

Sayın AYHAN'ın verdiği kod'da, kırmızı renklendirdiğim satırdan sonra mavi olan satırları ekleyerek deneyin.
.

[COLOR="Red"]                Cells(Satir, 6) = Split(TextBox1.Value, "*")(2)[/COLOR]
[COLOR="Blue"]                dlm = Array(0, 8, 16): vard = Array(1, 2, 3)
                Cells(Satir, 7) = WorksheetFunction.Lookup(Hour(Cells(Satir, 2)), dlm, vard) & ". Vardiya"[/COLOR]

 

[o2l3m]

Korhan Bey

Textbox da okuttuğum barkodun karakter sayısı 29 un üzerinde olduğunda sorun yaşıyorum.
Karakter sayısını kontrol etmese kod nasıl olurdu?

 

[askm]

Private Sub TextBox1_Change()
        If WorksheetFunction.CountIf(Range("C:C"), TextBox1.Value) > 0 Then
            TextBox1.Value = Empty
            Exit Sub
        Else
            Satir = Cells(Rows.Count, 2).End(3).Row + 1
            Cells(Satir, 2) = Now
            Cells(Satir, 3) = TextBox1.Value
            If InStr(1, TextBox1.Value, "*") > 0 Then
                Cells(Satir, 4) = Split(TextBox1.Value, "*")(0)
                Cells(Satir, 5) = Split(TextBox1.Value, "*")(1)
                Cells(Satir, 6) = Split(TextBox1.Value, "*")(2)
            End If
            TextBox1.Value = Empty
        End If
End Sub

 

[o2l3m]

Barcode Karakter sayısı kontrolünü kaldırınca okutma ve excele aktaramada sorun oluştu.
Başka bir türlü çözüm ne olabilir?

 

[o2l3m]

Sorunu çözdüm.

Örnek dosya ve kodları paylaşıyorum.

Private Sub TextBox3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

If KeyCode = 13 Then
If WorksheetFunction.CountIf(Range("C:C"), TextBox3.Value) > 0 Then
TextBox3.Value = Empty
Exit Sub
Else
Satir = Cells(Rows.Count, 2).End(3).Row + 1
Cells(Satir, 2) = Now
Cells(Satir, 3) = TextBox3.Value
If InStr(1, TextBox3.Value, "*") > 0 Then
Cells(Satir, 4) = Split(TextBox3.Value, "&")(0)
Cells(Satir, 5) = Split(TextBox3.Value, "&")(1)
Cells(Satir, 6) = Split(TextBox3.Value, "&")(2)
Cells(Satir, 7) = Split(TextBox3.Value, "&")(3)
Cells(Satir, 8) = Split(TextBox3.Value, "&")(4)
Cells(Satir, 9) = Split(TextBox3.Value, "&")(5)

End If
TextBox3.Text = ""
End If
End If

End Sub