เดเดนอ

* กระทู้นี้สามารถใช้งานได้เฉพาะผู้ที่มี Link นี้เท่านั้นค่ะ
กระทู้ข่าว
Option Explicit

' mapping คอลัมน์บนชีต DATA
Private Const COL_PARTNO As Long = 1
Private Const COL_PARTNAME As Long = 2
Private Const COL_BAL As Long = 3
Private Const COL_LOC As Long = 4
Private Const COL_IMG As Long = 5

Private mRow As Long 'แถวของรายการที่เลือกในชีต DATA

Private Sub UserForm_Initialize()
    Dim ws As Worksheet, lastRow As Long, i As Long
    Set ws = ThisWorkbook.Worksheets("DATA")
    lastRow = ws.Cells(ws.Rows.Count, COL_PARTNO).End(xlUp).Row

    Me.ComboBox1.Clear  'ใช้เลือก Part No เท่านั้น
    For i = 2 To lastRow
        Me.ComboBox1.AddItem ws.Cells(i, COL_PARTNO).Value
    Next i

    ClearFields
End Sub

Private Sub ComboBox1_Change()
    Dim ws As Worksheet, key As String
    Set ws = ThisWorkbook.Worksheets("DATA")
    key = Me.ComboBox1.Value
    If Len(key) = 0 Then Exit Sub

    mRow = FindRow(ws, key, COL_PARTNO)
    If mRow = 0 Then
        ClearFields
        Exit Sub
    End If
    UpdateUI ws, mRow
End Sub

Private Sub cmdUse_Click()
    AdjustStock -1   'ตัดสต็อก
End Sub

Private Sub cmdBuy_Click()
    AdjustStock 1    'รับเข้า/ซื้อเพิ่ม
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

'----------------- helpers -----------------

Private Sub UpdateUI(ByVal ws As Worksheet, ByVal r As Long)
    With Me
        ' ถ้าช่อง PartName/Balance/Location เป็น TextBox ให้เปลี่ยนชื่อคอนโทรลตามจริง
        .ComboBox2.Value = ws.Cells(r, COL_PARTNAME).Value
        .ComboBox3.Value = ws.Cells(r, COL_BAL).Value
        .ComboBox4.Value = ws.Cells(r, COL_LOC).Value
        ShowImage ws.Cells(r, COL_IMG).Value
    End With
End Sub

Private Sub AdjustStock(ByVal sign As Long)
    Dim ws As Worksheet, qty As Long, newBal As Long
    Dim logS As Worksheet, nextR As Long

    If mRow = 0 Then
        MsgBox "กรุณาเลือก Part No ก่อน", vbExclamation
        Exit Sub
    End If
    If Not IsNumeric(Me.txtQty.Value) Or CLng(Me.txtQty.Value) <= 0 Then
        MsgBox "กรอกจำนวนเป็นตัวเลขที่มากกว่า 0", vbExclamation
        Exit Sub
    End If

    qty = CLng(Me.txtQty.Value)
    Set ws = ThisWorkbook.Worksheets("DATA")

    newBal = CLng(Val(ws.Cells(mRow, COL_BAL).Value)) + sign * qty
    If newBal < 0 Then
        MsgBox "สต็อกไม่พอ (คงเหลือ " & ws.Cells(mRow, COL_BAL).Value & ")", vbExclamation
        Exit Sub
    End If

    ws.Cells(mRow, COL_BAL).Value = newBal
    Me.ComboBox3.Value = newBal
    Me.txtQty.Value = ""

    ' บันทึก log (ถ้ามีชีตชื่อ LOG จะเขียนเพิ่มให้)
    On Error Resume Next
    Set logS = ThisWorkbook.Worksheets("LOG")
    On Error GoTo 0
    If Not logS Is Nothing Then
        nextR = logS.Cells(logS.Rows.Count, 1).End(xlUp).Row + 1
        logS.Cells(nextR, 1).Value = Now
        logS.Cells(nextR, 2).Value = IIf(sign = 1, "BUY", "USE")
        logS.Cells(nextR, 3).Value = ws.Cells(mRow, COL_PARTNO).Value
        logS.Cells(nextR, 4).Value = ws.Cells(mRow, COL_PARTNAME).Value
        logS.Cells(nextR, 5).Value = qty
        logS.Cells(nextR, 6).Value = newBal
    End If
End Sub

Private Sub ShowImage(ByVal path As String)
    On Error Resume Next
    If Len(path) > 0 And Dir(path) <> "" Then
        Me.Image1.Picture = LoadPicture(path)
    Else
        Me.Image1.Picture = Nothing
    End If
    On Error GoTo 0
End Sub

Private Function FindRow(ByVal ws As Worksheet, ByVal key As String, ByVal col As Long) As Long
    Dim v As Variant
    v = Application.Match(key, ws.Columns(col), 0)
    If IsError(v) Then
        FindRow = 0
    Else
        FindRow = CLng(v)
    End If
End Function

Private Sub ClearFields()
    Me.ComboBox2.Value = ""
    Me.ComboBox3.Value = ""
    Me.ComboBox4.Value = ""
    Me.txtQty.Value = ""
    Me.Image1.Picture = Nothing
    mRow = 0
End Sub
แสดงความคิดเห็น
โปรดศึกษาและยอมรับนโยบายข้อมูลส่วนบุคคลก่อนเริ่มใช้งาน อ่านเพิ่มเติมได้ที่นี่