?? frmotherchk.frm
字號:
VERSION 5.00
Begin VB.Form FrmOtherChk
Caption = "采購入庫單審核"
ClientHeight = 4590
ClientLeft = 60
ClientTop = 345
ClientWidth = 7020
Icon = "FrmOtherChk.frx":0000
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 4590
ScaleWidth = 7020
Begin VB.CommandButton CmdCheck
Caption = "全部放棄(&U)"
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 1
Left = 5100
TabIndex = 6
Top = 1980
Width = 1635
End
Begin VB.CommandButton CmdCheck
Caption = "全部選中(&A)"
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 5100
TabIndex = 5
Top = 1200
Width = 1635
End
Begin VB.CommandButton CmdCheck
Caption = "退出(&X)"
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 3
Left = 5100
TabIndex = 4
Top = 3540
Width = 1635
End
Begin VB.CommandButton CmdCheck
Caption = "審核過帳(&C)"
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 2
Left = 5100
TabIndex = 3
Top = 2760
Width = 1635
End
Begin VB.ListBox LstDJ
Height = 3420
Left = 60
Style = 1 'Checkbox
TabIndex = 0
Top = 840
Width = 4755
End
Begin VB.Label LblCap
Caption = "單據編號 日期"
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Index = 1
Left = 300
TabIndex = 2
Top = 540
Width = 4395
End
Begin VB.Label LblCap
Caption = "請先選中將要審核過帳的單據，然后點擊“審核過帳”按鈕"
BeginProperty Font
Name = "宋體"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Index = 0
Left = 60
TabIndex = 1
Top = 180
Width = 5235
End
End
Attribute VB_Name = "FrmOtherChk"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private rsOTChk As ADODB.Recordset
Private cmOTChk As ADODB.Command
Private rsMHQP As ADODB.Recordset
Private Sub CmdCheck_Click(Index As Integer)
Dim intCur As Integer
Select Case Index
Case 0
For intCur = 0 To LstDJ.ListCount - 1
If LstDJ.Selected(intCur) = False Then
LstDJ.Selected(intCur) = True
End If
Next
Case 1
For intCur = 0 To LstDJ.ListCount - 1
If LstDJ.Selected(intCur) = True Then
LstDJ.Selected(intCur) = False
End If
Next
Case 2
Call OTCheck
For intCur = LstDJ.ListCount - 1 To 0 Step -1
If LstDJ.Selected(intCur) = True Then
LstDJ.RemoveItem intCur
End If
Next
MsgBox "審核過帳完畢!", , "審核過帳"
Case 3
Unload Me
End Select
End Sub
Private Sub Form_Load()
Dim strItem As String
intNumWindows = OpenWindow(intNumWindows)
Me.Height = 4995
Me.Width = 7140
Call SetFormStu(Me, frmMain)
Set rsOTChk = DEjxc.rsComOtHA
rsOTChk.Open
Set rsMHQP = New ADODB.Recordset
Set cmOTChk = New ADODB.Command
cmOTChk.ActiveConnection = DEjxc.Conjxc
cmOTChk.CommandType = adCmdText
With rsOTChk
If .RecordCount <> 0 Then
.MoveFirst
While Not .EOF
strItem = !other_id & Space(20) & !other_date
LstDJ.AddItem strItem
.MoveNext
Wend
End If
End With
End Sub
Private Sub OTCheck()
Dim strSQL As String
Dim intCur As Integer
Dim strOTID As String
For intCur = 0 To LstDJ.ListCount - 1
If LstDJ.Selected(intCur) = True Then
strOTID = Left(LstDJ.List(intCur), 9)
'將ORDER_DETAIL_A中的記錄加入到MAT_DETAIL中
' strSQL = "create table mattmp(p_id text(8)," & _
' "totalqty single,unit_price currency)"
' cmOTChk.CommandText = strSQL
' cmOTChk.Execute
' strSQL = "insert into mat_detail select p_id,qty,unit_price " & _
' "from order_detail_a where order_id='" & strOTID & "'"
' cmOTChk.CommandText = strSQL
' cmOTChk.Execute
' strSQL = "insert into mattmp select p_id,sum(qty) as " & _
' "totalqty,unit_price from mat_detail group by p_id,unit_price"
' cmOTChk.CommandText = strSQL
' cmOTChk.Execute
' strSQL = "delete from mat_detail"
' cmOTChk.CommandText = strSQL
' cmOTChk.Execute
' strSQL = "insert into mat_detail select p_id,totalqty " & _
' "as qty,unit_price from mattmp"
' cmOTChk.CommandText = strSQL
' cmOTChk.Execute
' strSQL = "drop table mattmp"
' cmOTChk.CommandText = strSQL
' cmOTChk.Execute
'將ORDER_DETAIL_A中的記錄加入到MAT_HEAD中
strSQL = "select p_id,sum(qty) as tq,sum(price) as tp from " & _
"order_detail_a where order_id='" & strOTID & "' group by " & _
"p_id"
rsMHQP.Open strSQL, DEjxc.Conjxc, adOpenStatic, adLockReadOnly
With rsMHQP
.MoveFirst
While Not .EOF
strSQL = "update mat_head set qty=qty+" & !tq & _
",price=price+" & !tp & " where p_id='" & !p_id & "'"
cmOTChk.CommandText = strSQL
cmOTChk.Execute
.MoveNext
Wend
End With
rsMHQP.Close
'將other_head_a中的記錄移動到other_head_b中
strSQL = "insert into other_head_b select * from other_head_a " & _
"where other_id='" & strOTID & "'"
cmOTChk.CommandText = strSQL
cmOTChk.Execute
strSQL = "delete from other_head_a " & "where other_id='" & strOTID & "'"
cmOTChk.CommandText = strSQL
cmOTChk.Execute
'將ORDER_DETAIL_A中的記錄移動到ORDER_DETAIL_B中
strSQL = "insert into order_detail_b select * from " & _
"order_detail_a where order_id='" & strOTID & "'"
cmOTChk.CommandText = strSQL
cmOTChk.Execute
strSQL = "delete from order_detail_a " & "where order_id='" & strOTID & "'"
cmOTChk.CommandText = strSQL
cmOTChk.Execute
End If
Next
End Sub
Private Sub Form_Unload(Cancel As Integer)
intNumWindows = Closewindow(intNumWindows)
rsOTChk.Close
Set rsOTChk = Nothing
Set cmOTChk = Nothing
Set rsMHQP = Nothing
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -