• DİKKAT

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

barkod satış proğramı

  • Konbuyu başlatan Konbuyu başlatan sel45
  • Başlangıç tarihi Başlangıç tarihi
S

sel45

Katılım
14 Ağustos 2015
Mesajlar
21
Excel Vers. ve Dili
office
iyi akşamlar ekte gönderdiğim şekilde proğram yaptım
sorunum şu a2 ye barkodu yazdığımda b2 cinsi ,c2 fiyat, d2 adet ,e2 tutar , f2 satış yapılan tarih yazıyor
barkod okuttuktan sonra 2 .satırdaki bilgiler bir alt satıra insin , 2.satır boş kalsın imleç a2 de sabit kalsın
yardımcı olursanız memnun olurum
 

Ekli dosyalar

Deneyebilirsiniz. Ayrıca tarih kısmındaki formülü kaldırdım, siz ürün barkodunu okuttuğunuzda tarih ve saat kendisi gelecektir.
 

Ekli dosyalar

barkod girdiğimde b.c.d.e sutunlarına veri gelmiyor sadece f sutununda tarih geliyor birde ben imleç a2 de sabit kalsın barkod okuttuğumda bilgiler otomatik alt satıra insin istiyorum
 
B,C,D,E sütunlarına girmiş olduğun formülleri alt satıra doğru çekerek bilgilerin gelmesini sağlayabilirsin. Şuan yaptığım işlem senin istediğinin tersi olmuş, çözersem eğer yardımcı olurum.
 
arkadaşlar yardımlarınızı bekliyorum
 
Aşağıdaki kodları SATIŞ sayfasının kod bölümüne yapıştırıp deneyin. A2 hücresine veri girince istediğiniz işlemi yapar:

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A2]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
Set s1 = Sheets("ürün")
son = s1.Cells(Rows.Count, "A").End(3).Row
If Target = "" Then
    [B2:F2] = ""
ElseIf WorksheetFunction.CountIf(s1.Range("A1:A" & son), Target) = 0 Then
    MsgBox "Girilen barkod ürün sayfasında bulunamadı!", vbCritical
    Target.Select
Else
    [B2] = WorksheetFunction.VLookup(Target, s1.Range("A1:C" & son), 2, 0)
    [C2] = WorksheetFunction.VLookup(Target, s1.Range("A1:C" & son), 3, 0)
    [E2].Formula = "=C2*D2"
    [F2] = Now
    Application.EnableEvents = False
        [A2:F2].Insert shift:=xlDown
        Rows("3:3").Copy: Rows("2:2").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    Application.EnableEvents = True
    [G2].FormulaR1C1 = "=SUM(RC[-2]:R[548]C[-2])"
    [A2].Select
End If

End Sub
 
YUSUF44' Alıntı:
Aşağıdaki kodları SATIŞ sayfasının kod bölümüne yapıştırıp deneyin. A2 hücresine veri girince istediğiniz işlemi yapar:

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A2]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
Set s1 = Sheets("ürün")
son = s1.Cells(Rows.Count, "A").End(3).Row
If Target = "" Then
    [B2:F2] = ""
ElseIf WorksheetFunction.CountIf(s1.Range("A1:A" & son), Target) = 0 Then
    MsgBox "Girilen barkod ürün sayfasında bulunamadı!", vbCritical
    Target.Select
Else
    [B2] = WorksheetFunction.VLookup(Target, s1.Range("A1:C" & son), 2, 0)
    [C2] = WorksheetFunction.VLookup(Target, s1.Range("A1:C" & son), 3, 0)
    [E2].Formula = "=C2*D2"
    [F2] = Now
    Application.EnableEvents = False
        [A2:F2].Insert shift:=xlDown
        Rows("3:3").Copy: Rows("2:2").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    Application.EnableEvents = True
    [G2].FormulaR1C1 = "=SUM(RC[-2]:R[548]C[-2])"
    [A2].Select
End If

End Sub
Genişletmek için tıkla ...
hocam elinize sağlık excel 2007 çalıştı
 
bu makroyu libreoffice ye uyarlayabilirmiyiz
 
Libre ofis makroları hakkında hiç bilgim yok maalesef.
 
Onun için satış arşiv hazırlanabilir. Hangi ürün ne kadar satmış, en fazla hangi ürün kazanmış şeklinde. Dosya üzerinden zaman geçince dosyaya uyarlama yapmak için motive olmak da zorlanıyorum.
 
Muhammet Okumuş' Alıntı:
Onun için satış arşiv hazırlanabilir. Hangi ürün ne kadar satmış, en fazla hangi ürün kazanmış şeklinde. Dosya üzerinden zaman geçince dosyaya uyarlama yapmak için motive olmak da zorlanıyorum.
Genişletmek için tıkla ...
anladım muhammet bey gerçekten bunu zaman ayırabilirseniz sevinirim sizin bu programı kapsamlı bir muhasebe programı yapacağım bilgi paylaşıldıkça çoğalır.buraya ekler herkesin işine yarayabilir.. ayrıca tel varsa alabilirmiyim..sizinle tanışmak istiyorum
 
Zamanında bir kırtasiye için hazırlamıştım. Basit ve kullanışlı. Aslında isteğiniz çok basit bir şey. Bu aralar çok yoğunum. Müsait olduğumda size bu eklentiyi uyarlayacağım.
 
Muhammet Okumuş' Alıntı:
Zamanında bir kırtasiye için hazırlamıştım. Basit ve kullanışlı. Aslında isteğiniz çok basit bir şey. Bu aralar çok yoğunum. Müsait olduğumda size bu eklentiyi uyarlayacağım.
Genişletmek için tıkla ...
sagolun muhamet bey gerçekten kullanışlı bir program ..mesala satış ekranında gözükmesin önemi yokta. data kısmına ürünü sınıflandırmak gerek market düşünelim ülker marka olsun ülkerin ürünleri var bir sürü ayrı ayrı raporlama yaparız sadece satıldığında önceden katogeri dataya oluştursak barkodtan bilir zaten satış yapınca satış sayfasına düşer..demek istediğim bir ürünün 3 ayrı alt katogerisi olabilir..sadece satıldıgında satış sayfasına atması yeterli olur.raporlamasını filtre yöntemiyle bile yaparız.. her türlü bilgiyi bakarız.
 
dataya stok ekleme ve satıldıgında düşmesi çok iyi yapmıssın
 
YUSUF44' Alıntı:
Aşağıdaki kodları SATIŞ sayfasının kod bölümüne yapıştırıp deneyin. A2 hücresine veri girince istediğiniz işlemi yapar:

PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A2]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then Exit Sub
Set s1 = Sheets("ürün")
son = s1.Cells(Rows.Count, "A").End(3).Row
If Target = "" Then
    [B2:F2] = ""
ElseIf WorksheetFunction.CountIf(s1.Range("A1:A" & son), Target) = 0 Then
    MsgBox "Girilen barkod ürün sayfasında bulunamadı!", vbCritical
    Target.Select
Else
    [B2] = WorksheetFunction.VLookup(Target, s1.Range("A1:C" & son), 2, 0)
    [C2] = WorksheetFunction.VLookup(Target, s1.Range("A1:C" & son), 3, 0)
    [E2].Formula = "=C2*D2"
    [F2] = Now
    Application.EnableEvents = False
        [A2:F2].Insert shift:=xlDown
        Rows("3:3").Copy: Rows("2:2").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    Application.EnableEvents = True
    [G2].FormulaR1C1 = "=SUM(RC[-2]:R[548]C[-2])"
    [A2].Select
End If

End Sub
Genişletmek için tıkla ...
merhabalar YUSUF BEY
Eski bir konu ama kodu SATIŞ bölümüne eklediğimde hata alıyorum
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst