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
เดเดนอ
* กระทู้นี้สามารถใช้งานได้เฉพาะผู้ที่มี Link นี้เท่านั้นค่ะ' 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