code vba excel หาจำนวนสินค้า เมื่อรหัสสินค้าซ้ำ

[kuaduang]

แนบไฟส์มาให้ช่วยตรวจความถูกต้องให้ด้วย

โปรแกรมร้านค้า.xlsm

ออกบิลเสร็จ กดบันทึก เป็นเสร็จ 1 บิล จะเริ่มบิลใหม่ เลือก E7 กดเลือกชื่อสินค้าที่ต้องการ มันไม่ทำงาน ต้องไปยกเลิกบิลก่อนแล้ว กด E7 จึงจะทำงาน ขอบคุณครับ

(64.52 KiB) Downloaded 27 times

[kuaduang]

ขอเพิ่มอีกนิดหนึ่ง ต้องการ ให้เลขที่บิล ขึ้นอัตโนมัติเมื่อมีการขายไปแต่ละบิลที่ G3 ต้องเพิ่ม code vba หรือ ใช้ฟังก์ชั้น
รบกวนแค่นี้ครับ ขอบคุณครับ

[snasui]

ที่ Procedure มีการ Disable Event เอาไว้ ดังนั้น ในทุก ๆ Exit Sub ที่เขียนใน Code ควรจะ Enable Event กลับมาเหมือนเดิม

Code: Select all

Public Sub SaveBill()
    Application.EnableEvents = False
    Debug.Print "Savebill"

    Dim ServiceCurrentID As Range
    Set ServiceCurrentID = Range("ServiceCurrentID")
    Dim ServiceCurrentQty As Range
    Set ServiceCurrentQty = Range("ServiceCurrentQty")
    
    Dim r As Long
    Dim id As String
    Dim header As String
    Dim recs As New Collection
    Dim rec As Variant
    Dim currentRow As Long, VATValue As Double, subTotal As Double, grandTotal As Double
    
    Dim printHeader As New ReceiPtHeader
    Dim printDetails As New Collection
    
    printHeader.billDate = Now()
    printHeader.customer = Range("ServiceCodeCus").Value
    header = addCSV(Format(printHeader.billDate, "yyyy/mm/dd h:mm:ss"))
    header = header & addCSV(printHeader.customer, True)
           
    
    Dim Code_Data As Range
    Dim ItemCost As Range
    Set Code_Data = Range("Code_Data")
    Set ItemCost = Range("ItemCost")
    
    Dim itemRec As ReceiptDetail
    For r = 1 To ServiceCurrentID.Count
        id = Trim(ServiceCurrentID.Cells(r, 1).Value)
        currentRow = ServiceCurrentID.Cells(r, 1).Row
        If id <> "" And ServiceCurrentQty.Cells(r, 1).Value > 0 Then
            'save record
            Set itemRec = New ReceiptDetail
            
            'id, title, qty, price, sub total, vat, grand total,cost
            With itemRec
                .itemID = id
                .title = Sheets("Service Invoice").Range("B" & currentRow).Value
                .qty = Sheets("Service Invoice").Range("F" & currentRow).Value
                .price = Sheets("Service Invoice").Range("E" & currentRow).Value
                .total = Sheets("Service Invoice").Range("G" & currentRow).Value
                
                rec = addCSV(.itemID, True, True)
                rec = rec & addCSV(.title, True)
                rec = rec & addCSV(.qty, True)
                rec = rec & addCSV(.price, True)
                rec = rec & addCSV(.total, True)
                subTotal = .total
                     
            End With
            
            Call printDetails.Add(itemRec)
            Call recs.Add(rec)
        End If
    Next r
    
    If recs.Count = 0 Then
        MsgBox "ไม่พบรายการขาย โปรดตรวจสอบอีกครั้ง", vbExclamation, "หน้าร้าน"
        Application.EnableEvents = True
        Exit Sub
    End If
    
    
    'save file to folder
    Dim targetFolder As String
    Dim resultFilename As String 'ขายหน้าร้าน_yyyy-mm.xlsx
    targetFolder = ActiveWorkbook.Path & "\data"
    resultFilename = targetFolder & "\b" & "ill" & "ขายหน้าร้าน_" & Format(Now(), "yyyy-mm") & ".csv"
    
    'check folder exist
    On Error GoTo saveError2
    Call ChDir(targetFolder)
    On Error GoTo saveError3
    Call ChDir(targetFolder)
    
    On Error GoTo 0
    'get current bill id
    Dim readLine As String
    Dim BillID As Long
    Open (targetFolder & "\ขายหน้าร้าน_id.txt") For Input As #1
    Line Input #1, readLine
    Close
    BillID = Val(readLine)
    saveBillID = BillID
    header = BillID & "," & header
    
    
    If Dir(resultFilename) = "" Then
        Open resultFilename For Output As #1
        Print #1, "บิลหมายเลข,วันที่,ลูกค้า,รหัสสินค้า,รายละเอียด,จำนวน,ราคา,รวมเป็นเงิน,VAT,รวมสุทธิ,ต้นทุน"
        Close #1
    End If

    Dim lineString As String
    Open resultFilename For Append As #1
    For Each rec In recs
        lineString = header & rec
        Print #1, lineString
    Next rec
    Close #1
    
    'add new id
    BillID = BillID + 1
    Open (targetFolder & "\ขายหน้าร้าน_id.txt") For Output As #1
    Print #1, BillID
    Close
    
    Range("ServiceCodeCus").Value = ""
    Range("ServiceCurrentID").ClearContents
    Range("ServiceCurrentQty").ClearContents
    Range("ServiceInputID").ClearContents
    Range("$G$24").ClearContents
    Range("ServiceInputID").Select
   
    Beep
    
    'print receipt
    Call PrintReceipt(printHeader, printDetails)
    
    'show form and exit
    frmStatus.Show
    Application.EnableEvents = True
    Exit Sub
    
    
saveError2:
    'create resultFolder
    Call MkDir(targetFolder)
    'create id file
    Open (targetFolder & "\ขายหน้าร้าน_id.txt") For Output As #1
    Print #1, "1"
    Close #1
    Resume Next
    
saveError3:
    MsgBox "ไม่สามารถเปิดโฟลเดอร์ " & targetFolder & " เพื่อบันทึกไฟล์ได้" & "โปรดตรวจสอบและบันทึกไฟล์ด้วยตัวท่านเอง", vbExclamation, "บิล" & ขายหน้าร้าน
    Application.EnableEvents = True
    Exit Sub

End Sub

กรณีต้องกรณีต้องการให้แสดงเลขที่ Invoice ในลำดับถัดไป ลองปรับ Code ที่ UserForm_Activate ตามด้านล่างครับ

Code: Select all

Private Sub UserForm_Activate()
    BillID.Caption = saveBillID
    Range("G4") = saveBillID + 1
End Sub

[kuaduang]

หาสาเหตุเจอพอดี ขอบคุณครับ การป้องกันแผ่นงาน เผื่อไปลบโดยบังเอิญ ป้องกันแล้ว ปุ่มบันทึก ปุ่มยกเลิกใช้ไม่ได้

[kuaduang]

ไฟส์สำเร็จรูปลองให้สมาชิกนำไปทดลองใช้งานดู ขัดข้อง ผิดพลาด เชิญที่ kuaduang_t@hotmail.com ครับ