?? frmzc1.frm
字號:
End Select
sMeg = sMeg & "不能為空！"
MsgBox sMeg, vbOKOnly + vbExclamation, "警告"
Combo1(intCount).SetFocus
Exit Sub
End If
Next intCount
'添加判斷是否有相同的ID記錄
If gintZCmode = 1 Then
txtSQL = "select * from zc where zc_no ='" & Trim(txtItem(0)) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If mrc.EOF = False Then
MsgBox "已經存在此轉倉單編號的記錄！", vbOKOnly + vbExclamation, "警告"
txtItem(0).SetFocus
Exit Sub
End If
mrc.Close
End If
'判斷轉出倉庫是否和轉入倉庫相同
If txtItem(2) = txtItem(3) Then
MsgBox "轉出倉庫和轉入倉庫相同，請重新選擇倉庫！", vbOKOnly + vbExclamation, "警告"
Combo1(1).SetFocus
Exit Sub
End If
'判斷轉出產品數量是否超過庫存
If gintZCmode = 1 Then
If CDbl(txtItem(7)) > CDbl(txtItem(10)) Then
MsgBox "轉出產品數量超過庫存，請重新選擇轉出產品數量！", vbOKOnly + vbExclamation, "警告"
txtItem(6).SetFocus
Exit Sub
End If
ElseIf gintZCmode = 2 Then
If (txtItem(2) = txtItem(11)) And (txtItem(4) = txtItem(13)) Then
If CDbl(txtItem(10)) + CDbl(txtItem(16)) < CDbl(txtItem(7)) Then
MsgBox "轉出產品數量超過庫存，請重新選擇轉出產品數量！", vbOKOnly + vbExclamation, "警告"
txtItem(6).SetFocus
Exit Sub
End If
Else
If CDbl(txtItem(7)) > CDbl(txtItem(10)) Then
MsgBox "轉出產品數量超過庫存，請重新選擇轉出產品數量！", vbOKOnly + vbExclamation, "警告"
txtItem(6).SetFocus
Exit Sub
End If
End If
End If
'先刪除已有記錄
txtSQL = "delete from zc where zc_no ='" & Trim(txtItem(0)) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
'再加入新記錄
txtSQL = "insert zc values ('"
For intCount = 0 To 1
txtSQL = txtSQL & Trim(txtItem(intCount)) & "','"
Next intCount
txtSQL = txtSQL & Trim(Combo1(0).ItemData(Combo1(0).ListIndex)) & "','"
For intCount = 2 To 4
txtSQL = txtSQL & Trim(txtItem(intCount)) & "','"
Next intCount
For intCount = 6 To 7
txtSQL = txtSQL & Trim(txtItem(intCount)) & "','"
Next intCount
txtSQL = txtSQL & Trim(txtItem(8)) & "')"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If gintZCmode = 1 Then
txtSQL = "select sl,total_je from kucun where ckdm = '" & Trim(txtItem(2))
txtSQL = txtSQL & "' and wzdm = '" & Trim(txtItem(4)) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If Not mrc.EOF Then
mrc.Fields(0) = mrc.Fields(0) - CDbl(txtItem(6))
mrc.Fields(1) = mrc.Fields(1) - CDbl(txtItem(7))
mrc.Update
End If
mrc.Close
txtSQL = "select sl,total_je from kucun where ckdm = '" & Trim(txtItem(3))
txtSQL = txtSQL & "' and wzdm = '" & txtItem(4) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If Not mrc.EOF Then
mrc.Fields(0) = mrc.Fields(0) + CDbl(txtItem(6))
mrc.Fields(1) = mrc.Fields(1) + CDbl(txtItem(7))
mrc.Update
mrc.Close
Else
mrc.Close
txtSQL = "execute kucun_setup '"
txtSQL = txtSQL & txtItem(1) & "','"
txtSQL = txtSQL & GetRkno() & "','"
txtSQL = txtSQL & txtItem(3) & "','"
txtSQL = txtSQL & txtItem(4) & "','"
txtSQL = txtSQL & txtItem(6) & "','"
txtSQL = txtSQL & txtItem(7) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
End If
MsgBox "添加記錄成功！", vbOKOnly + vbExclamation, "添加記錄"
txtItem(1) = Format(Now, "yyyy-mm-dd")
mblChange = False
Unload frmZC
frmZC.txtSQL = "select * from zc"
frmZC.Show
ElseIf gintZCmode = 2 Then
txtSQL = "select sl,total_je from kucun where ckdm = '" & Trim(txtItem(11).Text)
txtSQL = txtSQL & "' and wzdm = '" & Trim(txtItem(13).Text) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If Not mrc.EOF Then
mrc.Fields(0) = mrc.Fields(0) + CDbl(txtItem(15).Text)
mrc.Fields(1) = mrc.Fields(1) + CDbl(txtItem(16).Text)
mrc.Update
End If
mrc.Close
txtSQL = "select sl,total_je from kucun where ckdm = '" & Trim(txtItem(12))
txtSQL = txtSQL & "' and wzdm = '" & Trim(txtItem(13)) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If Not mrc.EOF Then
mrc.Fields(0) = mrc.Fields(0) - CDbl(txtItem(15).Text)
mrc.Fields(1) = mrc.Fields(1) - CDbl(txtItem(16).Text)
mrc.Update
End If
mrc.Close
txtSQL = "select sl,total_je from kucun where ckdm = '" & Trim(txtItem(2))
txtSQL = txtSQL & "' and wzdm = '" & Trim(txtItem(4)) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If Not mrc.EOF Then
mrc.Fields(0) = mrc.Fields(0) - CDbl(txtItem(6))
mrc.Fields(1) = mrc.Fields(1) - CDbl(txtItem(7))
mrc.Update
End If
mrc.Close
txtSQL = "select sl,total_je from kucun where ckdm = '" & Trim(txtItem(3))
txtSQL = txtSQL & "' and wzdm = '" & txtItem(4) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If Not mrc.EOF Then
mrc.Fields(0) = mrc.Fields(0) + CDbl(txtItem(6))
mrc.Fields(1) = mrc.Fields(1) + CDbl(txtItem(7))
mrc.Update
mrc.Close
Else
mrc.Close
txtSQL = "execute kucun_setup '"
txtSQL = txtSQL & txtItem(1) & "','"
txtSQL = txtSQL & GetRkno() & "','"
txtSQL = txtSQL & txtItem(3) & "','"
txtSQL = txtSQL & txtItem(4) & "','"
txtSQL = txtSQL & txtItem(6) & "','"
txtSQL = txtSQL & txtItem(7) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
End If
Unload Me
Unload frmZC
frmZC.txtSQL = "select * from zc"
frmZC.Show
End If
End Sub
Private Sub Combo1_Change(Index As Integer)
mblChange = True
End Sub
Private Sub Combo1_Click(Index As Integer)
Dim mrcc As ADODB.Recordset
Dim mrcd As ADODB.Recordset
Dim MsgText As String
If Index = 1 Then
Combo1(3).Clear
txtSQL = "select dm from dm_ck where mc = '" & Trim(Combo1(Index)) & "'"
Set mrcc = ExecuteSQL(txtSQL, MsgText)
If Not mrcc.EOF Then
txtItem(Index + 1) = mrcc.Fields(0)
End If
mrcc.Close
txtSQL = "select dm_wz.mc from dm_wz inner join kucun on dm_wz.dm = kucun.wzdm where kucun.sl > '0' and kucun.ckdm = '" & txtItem(2) & "'"
Set mrcc = ExecuteSQL(txtSQL, MsgText)
If Not mrcc.EOF Then
Do While Not mrcc.EOF
Combo1(3).AddItem mrcc.Fields(0)
mrcc.MoveNext
Loop
End If
mrcc.Close
ElseIf Index = 2 Then
txtSQL = "select dm from dm_ck where mc = '" & Trim(Combo1(Index)) & "'"
Set mrcc = ExecuteSQL(txtSQL, MsgText)
If Not mrcc.EOF Then
txtItem(Index + 1) = mrcc.Fields(0)
End If
mrcc.Close
ElseIf Index = 3 Then
If Trim(Combo1(1) & " ") = "" Then
MsgBox "請先選擇轉出倉庫！", vbOKOnly + vbExclamation, "警告"
Combo1(1).SetFocus
Exit Sub
Else
txtSQL = "select kucun.wzdm,danj=(kucun.total_je/kucun.sl),kucun.total_je from dm_wz inner join kucun on dm_wz.dm = kucun.wzdm where dm_wz.mc = '" & Trim(Combo1(Index)) & "' and kucun.ckdm ='" & Trim(txtItem(2)) & "'"
Set mrcc = ExecuteSQL(txtSQL, MsgText)
If Not mrcc.EOF Then
txtItem(4) = mrcc.Fields(0)
txtItem(9) = mrcc.Fields(1)
txtItem(10) = mrcc.Fields(2)
End If
mrcc.Close
End If
End If
End Sub
Private Sub Form_Load()
Dim intCount As Integer
Dim MsgText As String
Dim i As Integer
Dim mrcc As ADODB.Recordset
If gintZCmode = 1 Then
Me.Caption = Me.Caption & "添加"
For i = 0 To 16
txtItem(i).Text = ""
Next i
For i = 0 To 3
Combo1(i).Clear
Next i
ElseIf gintZCmode = 2 Then
Set mrc = ExecuteSQL(txtSQL, MsgText)
If mrc.EOF = False Then
With mrc
For intCount = 0 To 1
txtItem(intCount) = .Fields(intCount)
Next intCount
For intCount = 2 To 4
txtItem(intCount) = .Fields(intCount + 1)
Next intCount
For intCount = 6 To 8
txtItem(intCount) = .Fields(intCount)
Next intCount
For intCount = 2 To 4
txtItem(intCount + 9) = txtItem(intCount)
Next intCount
For intCount = 6 To 7
txtItem(intCount + 9) = txtItem(intCount)
Next intCount
End With
End If
Me.Caption = Me.Caption & "修改"
End If
For i = 0 To 3
Combo1(i).Clear
Next i
txtSQL = "select dm,mc from dm_ywy"
Set mrcc = ExecuteSQL(txtSQL, MsgText)
If Not mrcc.EOF Then
Do While Not mrcc.EOF
Combo1(0).AddItem mrcc.Fields(1)
Combo1(0).ItemData(Combo1(0).NewIndex) = mrcc.Fields(0)
mrcc.MoveNext
Loop
End If
mrcc.Close
txtItem(1) = Format(Now, "yyyy-mm-dd")
txtItem(1).Enabled = False
txtSQL = "select mc from dm_ck"
Set mrcc = ExecuteSQL(txtSQL, MsgText)
If Not mrcc.EOF Then
Do While Not mrcc.EOF
Combo1(1).AddItem mrcc.Fields(0)
Combo1(2).AddItem mrcc.Fields(0)
mrcc.MoveNext
Loop
End If
mrcc.Close
mblChange = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
gintZCmode = 0
End Sub
Private Sub txtItem_Change(Index As Integer)
Dim intCount As Integer
'用于計算工資
Dim dblTotal As Double
'有變化設置gblchange
mblChange = True
If Not Trim(Combo1(3)) = "" Then
If (Index = 6) Then
dblTotal = 0
dblTotal = CDbl(txtItem(6)) * CDbl(txtItem(9))
txtItem(7) = Format(dblTotal, "#0.00")
End If
End If
Exit Sub
End Sub
Private Sub txtItem_GotFocus(Index As Integer)
txtItem(Index).SelStart = 0
txtItem(Index).SelLength = Len(txtItem(Index))
End Sub
Private Sub txtItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
EnterToTab KeyCode
End Sub
Private Sub txtItem_KeyPress(Index As Integer, KeyAscii As Integer)
If Index >= 6 And Index <= 7 Then
'MsgBox KeyCode
'對鍵入字符進行控制
'txtQuantity(Index).Locked = False
'小數點只允許輸入一次
If KeyAscii = 190 Then
If InStr(Trim(txtItem(Index)), ".") = 0 Then
If Len(Trim(txtItem(Index))) > 0 Then
txtItem(Index).Locked = False
Else
txtItem(Index).Locked = True
End If
Else
txtItem(Index).Locked = True
End If
Exit Sub
End If
'非數字不能輸入
If KeyAscii > 57 Or KeyAscii < 48 Then
txtItem(Index).Locked = True
Else
txtItem(Index).Locked = False
End If
'允許Backspace
If KeyAscii = 8 Then
txtItem(Index).Locked = False
End If
'Delete鍵
If KeyAscii = 46 Then
txtItem(Index).Locked = False
End If
End If
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -