Snasui Excel Forum

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

Code: Select all

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

Code: Select all

Public Sub CancelBill()
    Application.EnableEvents = False
    Debug.Print "Cancelbill"
    
    If MsgBox("ต้องการยกเลิกบิลที่กำลังทำงานอยู่", vbQuestion + vbYesNo + vbDefaultButton2, "ขายหน้าร้าน") = vbYes Then
        Range("ServiceCurrentID").ClearContents
        Range("ServiceCurrentQty").ClearContents
        Range("ServiceInputID").ClearContents
        Range("$G$24").ClearContents
        Range("ServiceInputID").Select
        
    End If
    Application.EnableEvents = True
End Sub

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    Select Case Target.Address
        Case "$E$7"
            Call AddVal
            Range("E7").Select
            'reset qty after add id
            If Range("G7").Value > 1 Then Range("G7").Value = 1
        Case "$G$7"
            If Target.Value < 1 Then Target.Value = 1
        Case Else:
            If Left(Target.Address, 6) = "$F$" Then
                If Target.Row >= 13 And Target.Row <= 22 Then
                    If IsEmpty(Target.Value) Then
                        Range("F" & Target.Row).ClearContents
                    End If
                End If
            End If
            'Debug.Print "x " & Target.Address
    End Select
End Sub

Code: Select all

Sub AddVal()
    Dim i As Integer, rCheck As Range
    Dim rAll As Range, rsAll As Range
    Dim id As String, l As Long
    With Sheets("DATA_ITEM")
        Set rsAll = .Range("C:C")
    End With
    With Sheets("Service Invoice")
        Set rCheck = .Range("E7")
        If Application.CountIf(rsAll, rCheck) > 0 Then
            l = Application.Match(rCheck, rsAll, 0)
            id = Sheets("DATA_ITEM").Range("B" & l)
        Else
            Call addNewItem(rCheck.Value)
        End If
        If Application.CountIf(.Range("A:A"), id) > 0 Then
            i = Application.Match(id, .Range("A:A"), 0)
            .Range("F" & i) = .Range("F" & i) + 1
        Else
            Call addNewItem(rCheck.Value)
        End If
    End With
End Sub