?? frmmaterin1.frm
字號:
cboItem(3).Enabled = True
cboItem(4).Enabled = True
cboItem(2).Clear
cboItem(0).Clear
cboItem(3).Clear
cboItem(4).Clear
txtSQL = "select wzid,wzspec,wzkind,wzunit from material where wzname='" & Trim(cboItem(1)) & "'"
Set mrcc = ExecuteSQL(txtSQL, MsgText)
If Not mrcc.EOF Then
Do While Not mrcc.EOF
cboItem(0).AddItem mrcc!wzid
cboItem(2).AddItem mrcc!wzspec
cboItem(3).AddItem mrcc!wzkind
cboItem(4).AddItem mrcc!wzunit
mrcc.MoveNext
Loop
cboItem(0).Enabled = False
cboItem(3).Enabled = False
cboItem(4).Enabled = False
cboItem(2).ListIndex = 0
cmdSave.Enabled = True
Else
MsgBox "請先建立物資檔案!", vbOKOnly + vbExclamation, "警告"
cmdSave.Enabled = False
Exit Sub
End If
mrcc.Close
ElseIf Index = 2 Then
cboItem(0).Enabled = True
cboItem(3).Enabled = True
cboItem(4).Enabled = True
With cboItem(2)
cboItem(0).ListIndex = .ListIndex
cboItem(3).ListIndex = .ListIndex
cboItem(4).ListIndex = .ListIndex
End With
cboItem(0).Enabled = False
cboItem(3).Enabled = False
cboItem(4).Enabled = False
End If
End If
Exit Sub
End Sub
Private Sub cboItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
EnterToTab KeyCode
End Sub
Private Sub cmdExit_Click()
If mblChange And cmdSave.Enabled Then
If MsgBox("保存當前記錄的變化嗎?", vbOKCancel + vbExclamation, "警告") = vbOK Then
'保存
Call cmdSave_Click
End If
End If
Unload Me
End Sub
Private Sub cmdSave_Click()
Dim intCount As Integer
Dim sMeg As String
Dim mrcc As ADODB.Recordset
Dim MsgText As String
For intCount = 0 To 5
If Trim(txtItem(intCount) & " ") = "" Then
Select Case intCount
Case 0
sMeg = "數量"
Case 1
sMeg = "單價"
Case 2
sMeg = "金額"
Case 3
sMeg = "入庫時間"
Case 4
sMeg = "經辦人"
Case 5
sMeg = "保管人"
End Select
sMeg = sMeg & "不能為空!"
MsgBox sMeg, vbOKOnly + vbExclamation, "警告"
txtItem(intCount).SetFocus
Exit Sub
End If
Next intCount
If IsDate(txtItem(3)) Then
txtItem(3) = Format(txtItem(3), "yyyy-mm-dd")
Else
MsgBox "入庫時間應輸入日期(yyyy-mm-dd)!", vbOKOnly + vbExclamation, "警告"
txtItem(3).SetFocus
Exit Sub
End If
'判斷余額庫中是否有rkid的記錄
txtSQL = "select * from msurplus where yeid='" & Trim(cboItem(0)) & "' and yebase='" & Trim(txtItem(6) & " ") & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If mrc.EOF = True Then '為空
'向余額庫加入新記錄
mrc.Close
txtSQL = "select * from msurplus"
Set mrcc = ExecuteSQL(txtSQL, MsgText)
mrcc.AddNew
mrcc.Fields(0) = Trim(cboItem(0))
For intCount = 1 To 4
If Trim(cboItem(intCount) & " ") = "" Then
mrcc.Fields(intCount) = Null
Else
mrcc.Fields(intCount) = Trim(cboItem(intCount))
End If
Next intCount
mrcc.Fields(5) = 0
mrcc.Fields(6) = 0
mrcc.Fields(7) = Trim(txtItem(6) & " ")
mrcc.Fields(8) = Null
mrcc.Update
mrcc.Close
Else
mrc.Close
End If
If gintImode = 2 Then
'先刪除已有記錄
txtSQL = "delete from msave where rkno='" & Trim(txtNo) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
txtSQL = "update msurplus set yeaccount=yeaccount-" & Trim(txtAccount) & ",yevalue=yevalue-" & Trim(txtValue) & " where yeid='" & Trim(cboItem(0)) & "' and yebase='" & Trim(txtBase) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
End If
'再加入新記錄
txtSQL = "select * from msave"
Set mrc = ExecuteSQL(txtSQL, MsgText)
mrc.AddNew
mrc.Fields(0) = Trim(txtNo)
For intCount = 0 To 4
If Trim(cboItem(intCount) & " ") = "" Then
mrc.Fields(intCount + 1) = Null
Else
mrc.Fields(intCount + 1) = Trim(cboItem(intCount))
End If
Next intCount
For intCount = 0 To 7
If Trim(txtItem(intCount) & " ") = "" Then
mrc.Fields(intCount + 6) = Null
Else
mrc.Fields(intCount + 6) = Trim(txtItem(intCount))
End If
Next intCount
mrc.Update
mrc.Close
'刷新余額庫
txtSQL = "update msurplus set yeaccount=yeaccount+" & Trim(txtItem(0)) & ",yevalue=yevalue+" & Trim(txtItem(2)) & " where yeid='" & Trim(cboItem(0)) & "' and yebase='" & Trim(txtItem(6) & " ") & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If gintImode = 1 Then
For intCount = 0 To 7
txtItem(intCount) = ""
Next intCount
txtNo = GetRkno
mblChange = False
If flagIedit Then
Unload frmMaterIn
frmMaterIn.txtSQL = "select * from msave"
frmMaterIn.Show
End If
ElseIf gintImode = 2 Then
Unload Me
If flagIedit Then
Unload frmMaterIn
End If
frmMaterIn.txtSQL = "select * from msave"
frmMaterIn.Show
End If
End Sub
Private Sub Form_Load()
Dim sSql As String
Dim intCount As Integer
Dim MsgText As String
If gintImode = 1 Then
Me.Caption = Me.Caption & "添加"
'初始化物資名稱
txtSQL = "select DISTINCT wzname from material"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If Not mrc.EOF Then
Do While Not mrc.EOF
cboItem(1).AddItem Trim(mrc!wzname)
mrc.MoveNext
Loop
cboItem(1).ListIndex = 0
Else
MsgBox "請先進行物資登記!", vbOKOnly + vbExclamation, "警告"
cmdSave.Enabled = False
Exit Sub
End If
mrc.Close
txtAccount = "0"
txtValue = "0"
txtNo = GetRkno
txtBase = " "
ElseIf gintImode = 2 Then
Set mrc = ExecuteSQL(txtSQL, MsgText)
If mrc.EOF = False Then
With mrc
For intCount = 0 To 4
cboItem(intCount).AddItem .Fields(intCount + 1)
cboItem(intCount).ListIndex = 0
Next intCount
For intCount = 0 To 7
If Not IsNull(.Fields(intCount + 6)) Then
txtItem(intCount) = .Fields(intCount + 6)
End If
Next intCount
'保存更改數據
txtAccount = !rkaccount
txtValue = !rkvalue
txtNo = !rkno
txtBase = !rkbase & " "
End With
End If
mrc.Close
Me.Caption = Me.Caption & "修改"
End If
mblChange = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
gintImode = 0
End Sub
Private Sub txtItem_Change(Index As Integer)
'有變化設置gblchange
mblChange = True
If Index = 0 Or Index = 1 Then
If Trim(txtItem(0) & " ") <> "" And Trim(txtItem(1) & " ") <> "" Then
txtItem(2) = Format(CDbl(txtItem(0)) * CDbl(txtItem(1)), "#0.00")
Else
txtItem(2) = 0
End If
End If
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 Function GetRkno() As String
GetRkno = Format(Now, "yymmddhhmmss")
Randomize
GetRkno = GetRkno & Int((99 - 10 + 1) * Rnd + 10)
End Function
Private Sub txtItem_KeyPress(Index As Integer, KeyAscii As Integer)
If Index = 0 Or Index = 1 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 + -