maintainpartbill.frm
来自「一个关于电脑管理汽车的软件」· FRM 代码 · 共 1,169 行 · 第 1/3 页
FRM
1,169 行
.CloseRecordset
.ReleaseMemory
Set TempRS = Nothing
MsgBox "所需退的货品已经超过库存量,操作失败", , VarInitData.SysPrompt
Exit Sub
End If
.MoveNext
Loop
End With
With TempRS
.MoveFirst
Do Until .EOF
VarInitData.SellReduceFrStore TempRS, True
.MoveNext
Loop
End With
TempRS.CloseRecordset
TempRS.ReleaseMemory
Set TempRS = Nothing
TempSQL = "Delete from stocktable2 Where billnum = " & Quote(Trim(StockTable.lstAddress.ListItems(StockTable.lstAddressIndex).Text))
gCnn.Execute TempSQL
TempSQL = "Delete from stocktable Where billnum = " & Quote(Trim(StockTable.lstAddress.ListItems(StockTable.lstAddressIndex).Text))
gCnn.Execute TempSQL
TempSQL = VarInitData.DisplaySQLVal(1)
VarInitData.LoadData lstAddress, TempSQL
Else
MsgBox "货物单据为空,操作失败", , VarInitData.SysPrompt
End If
Case 6
'If lstAddress.SelectedItem Is Nothing Then Exit Sub
'VarCrystal.DispalySellReport lstAddress.SelectedItem.Text, 15
' rptReport.Show
End Select
VarInitData.DealListView lstAddress, lstAddressIndex
End Sub
Private Sub Command3_Click(Index As Integer)
Dim TempSQL As String
Dim TempCount As Long, TempMoney As Long
Dim TempMoney2 As Long, TemplstCount As Long
Dim i As Long, j As Long, TempFindIndex As Long
Dim TempRS As MYSQL_RS, MyItems As ListItems
Dim GoodsPriceMoney As Double
Select Case Index
Case 0 '增加新的记录"
' If lblBillNum.Caption <> "" Then
AddRow10.Show 1
' End If
Case 1 '删除记录
If lstBillDocu.ListItems.Count > 0 And lstBillDocuIndex > 0 Then
If MsgBox("确定删除这条记录吗?", vbOKCancel, VarInitData.SysPrompt) = vbOK Then
lstBillDocu.ListItems.Remove lstBillDocuIndex
OrgRS.DeleteKeyRS lstBillDocuIndex
With MaintainPartBill
TemplstCount = .lstBillDocu.ListItems.Count
.lblGItemCount = TemplstCount
TempCount = 0
TempMoney = 0
For i = 1 To TemplstCount
TempCount = TempCount + Val(.lstBillDocu.ListItems(i).SubItems(3))
TempMoney = TempMoney + Val(.lstBillDocu.ListItems(i).SubItems(6))
Next i
.lblGCount = TempCount
.lblGMoney = TempMoney
End With
End If
End If
Case 2 '保存
If lstBillDocu.ListItems.Count > 0 And lstBillDocuIndex > 0 Then
If lblProvide = "" Then
MsgBox "工作单号不能为空", , VarInitData.SysPrompt
Exit Sub
End If
TempCount = lstBillDocu.ListItems.Count
Set MyItems = lstBillDocu.ListItems
For i = 1 To TempCount
If VarInitData.DrawReduceFrStore(MyItems(i), False) = False Then
If Val(MyItems(i).Text) >= 0 Then
MsgBox "领用的货品在库存没有,操作失败", , VarInitData.SysPrompt
Exit Sub
Else
MsgBox "库存中无此货物,入库失败", , VarInitData.SysPrompt
End If
End If
Next i
SaveToDrawBill
VarOption = 0
TempSQL = "select * from maintainpartbill2" '& " Where billnum = " & Quote(Trim(lblBillNum.Caption))
Set TempRS = New MYSQL_RS
TempRS.OpenRs TempSQL, gCnn
With TempRS
If .RecordCount > 0 Then
.MoveLast
.MoveNext
End If
For i = 1 To TempCount
' If Val(MyItems(i).SubItems(3)) >= 0 Then
VarInitData.DrawReduceFrStore MyItems(i), True, GoodsPriceMoney
' Else
' VarInitData.DrawSaveToStore MyItems(i), True, GoodsPriceMoney
' End If
SaveToDrawBillDocu TempRS, lstBillDocu, i, GoodsPriceMoney
Next i
.CloseRecordset
.ReleaseMemory
Set TempRS = Nothing
End With
End If
Frame2.Enabled = False
BillStateBS = 0
For i = 0 To 3
Command3(i).Visible = False
Next i
For i = 0 To 5
Command1(i).Visible = True
Next i
SSStock.TabEnabled(0) = True
SSStock.Tab = 0
Case 3
VarOption = 0
Frame2.Enabled = False
BillStateBS = 0
For i = 0 To 3
Command3(i).Visible = False
Next i
For i = 0 To 5
Command1(i).Visible = True
Next i
SSStock.TabEnabled(0) = True
SSStock.Tab = 0
OrgRS.Clear
VarInitData.LoadData lstBillDocu, VarInitData.DisplaySQLVal(39)
End Select
VarInitData.DealListView lstBillDocu, lstBillDocuIndex
End Sub
Private Sub Form_Activate()
VarInitData.DealListView lstAddress, lstAddressIndex
End Sub
Private Sub Form_Load()
Dim i As Integer
Dim TempSQL As String
VarInitData.InitBSE BSE1
Frame2.Visible = False
Frame2.Enabled = False
lstBillDocu.Visible = False
lstAddress.Visible = True
For i = 0 To 3
Command3(i).Visible = False
Next i
Command1(2).Enabled = False
Command1(5).Enabled = False
VarInitData.LoadData lstAddress, VarInitData.DisplaySQLVal(38)
Set OrgRS = New ChangeHistory
TempSQL = "Select name From workertable "
VarInitData.LoadData cmbPrincipal, TempSQL, 1
VarInitData.LoadData cmbCheckMan, TempSQL, 1
End Sub
Private Sub Form_Resize()
If Me.ScaleHeight > 0 And Me.ScaleWidth > 0 Then
frameInfo.left = Me.ScaleLeft
frameInfo.top = Me.ScaleTop
frameInfo.Width = Me.ScaleWidth
SSStock.top = frameInfo.top + frameInfo.Height
SSStock.left = Me.ScaleLeft + 70
SSStock.Width = Me.ScaleWidth - 140
SSStock.Height = Me.ScaleHeight - frameInfo.Height - 50 'Screen.Height - 2650
lstAddress.top = 450
lstAddress.left = 70
lstAddress.Width = SSStock.Width - 140
lstAddress.Height = SSStock.Height - 550
Frame2.left = 70
Frame2.top = 450
Frame2.Width = SSStock.Width - 140
lstBillDocu.top = Frame2.top + Frame2.Height
lstBillDocu.left = 70
lstBillDocu.Width = SSStock.Width - 140
lstBillDocu.Height = SSStock.Height - Frame2.Height - 550
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
If BSE1.EngineStarted Then BSE1.EndSubClassing
End Sub
Private Sub lstAddress_DblClick()
If lstAddress.SelectedItem Is Nothing Then Exit Sub
' LoadRecord Val(lstAddress.SelectedItem.Text)
End Sub
Private Sub lstAddress_ItemClick(ByVal Item As MSComctlLib.ListItem)
'Dim templong As Long
'Stop
lstAddressIndex = Item.Index
'templong = Item.Text
End Sub
Private Sub lstBillDocu_DblClick()
If BillStateBS > 0 Then
If lstBillDocu.SelectedItem Is Nothing Then Exit Sub
ModifyBS = True
lstBillDocuIndex = lstBillDocu.SelectedItem.Index
AddRow10.Show 1
End If
End Sub
Private Sub lstBillDocu_ItemClick(ByVal Item As MSComctlLib.ListItem)
lstBillDocuIndex = Item.Index
End Sub
Private Sub Option1_Click(Index As Integer)
VarOption = Index + 1
End Sub
Private Sub Picture1_Click()
MeetCarBillFind.Show 1
End Sub
Private Sub SSStock_Click(PreviousTab As Integer)
Dim TempSQL As String
Dim TempStr As String
Dim TempRS As MYSQL_RS
Dim TempBillType As Integer
Dim i As Integer
If PreviousTab <> 0 Then
For i = 0 To 5
Command1(i).Visible = True
Next i
For i = 0 To 3
Command3(i).Visible = False
Next i
Frame2.Visible = False
lstBillDocu.Visible = False
lstAddress.Visible = True
VarInitData.DealListView lstAddress, lstAddressIndex
Else
Frame2.Visible = True
If BillStateBS > 0 Then
Frame2.Enabled = True
Else
Frame2.Enabled = False
End If
lstBillDocu.Visible = True
lstAddress.Visible = False
If BillStateBS <> 1 Then ClearFrame2
If lstAddress.ListItems.Count > 0 Then
TempStr = lstAddress.ListItems(lstAddressIndex).Text
Else
TempStr = ""
End If
If BillStateBS = 1 Then TempStr = ""
TempSQL = VarInitData.DisplaySQLVal(39) & " Where drawbillnum = " & Quote(TempStr)
VarInitData.LoadData2 lstBillDocu, TempSQL, OrgRS
VarInitData.DealListView lstBillDocu, lstBillDocuIndex
If lstAddressIndex > 0 And lstAddress.ListItems.Count > 0 Then
If BillStateBS <> 1 Then
With lstAddress.ListItems(lstAddressIndex)
MaintainPartBill.lblBillNum = .Text
MaintainPartBill.lblProvide = .SubItems(1)
DTDate.Value = .SubItems(2)
MaintainPartBill.cmbPrincipal = .SubItems(3)
MaintainPartBill.cmbCheckMan = .SubItems(4)
MaintainPartBill.lblGCount = .SubItems(5)
MaintainPartBill.lblGMoney = .SubItems(6)
MaintainPartBill.lblGItemCount = .SubItems(7)
MaintainPartBill.lblOperateMan = .SubItems(8)
lblCarno = .SubItems(9)
End With
End If
End If
End If
End Sub
Private Sub ClearFrame2()
With MaintainPartBill
.lblBillNum = ""
.lblProvide = ""
.lblGCount = "0"
.lblGItemCount = "0"
.lblOperateMan = ""
.lblGMoney = "0"
.cmbCheckMan = ""
.cmbPrincipal = ""
.DTDate = Date
End With
End Sub
Private Sub SaveToDrawBill()
Dim TempRS As MYSQL_RS
Dim i As Integer
Dim TempSQL As String
Set TempRS = New MYSQL_RS
If BillStateBS = 2 Then
TempSQL = "Select * From maintainpartbill Where drawbillnum = " & Quote(Trim(lblBillNum))
ElseIf BillStateBS = 1 Then
TempSQL = "Select * From counttable where countname =" & Quote("维修领用单")
TempRS.OpenRs TempSQL, gCnn
TempRS.Fields("count").Value = CLng(TempRS.Fields("count").Value) + 1
lblBillNum = VarInitData.DealVarNo(CStr(TempRS.Fields("count")), 6, "L")
TempRS.Update
TempRS.CloseRecordset
TempRS.ReleaseMemory
Set TempRS = Nothing
Set TempRS = New MYSQL_RS
TempSQL = "Select * From maintainpartbill" 'Where AKey = " & Val(txtAKey)
End If
TempRS.OpenRs TempSQL, gCnn
If BillStateBS <> 2 Then
If TempRS.RecordCount > 0 Then
TempRS.MoveLast
TempRS.MoveNext
End If
End If
With TempRS
If .EOF Then .AddNew
.Fields("drawbillnum") = lblBillNum.Caption
.Fields("workbillnum") = MaintainPartBill.lblProvide
.Fields("drawdate") = MaintainPartBill.DTDate
.Fields("drawman") = MaintainPartBill.cmbPrincipal
.Fields("sendgoodsman") = MaintainPartBill.cmbCheckMan
.Fields("gcount") = Val(MaintainPartBill.lblGCount)
.Fields("gmoney") = Val(MaintainPartBill.lblGMoney)
.Fields("gitemcount") = Val(MaintainPartBill.lblGItemCount)
.Fields("operateman") = MaintainPartBill.lblOperateMan
.Fields("carno") = MaintainPartBill.lblCarno
.Update
.CloseRecordset
.ReleaseMemory
End With
Set TempRS = Nothing
TempSQL = VarInitData.DisplaySQLVal(38)
VarInitData.LoadData lstAddress, TempSQL
End Sub
Private Sub SaveToDrawBillDocu(VarRS As MYSQL_RS, lstBillDocu As ListView, ByVal i As Long, ByVal GoodsPriceMoney As Double)
With VarRS
If .EOF Then .AddNew
.Fields("drawbillnum") = lblBillNum
.Fields("goodscoding") = lstBillDocu.ListItems(i).Text
.Fields("goodsname") = lstBillDocu.ListItems(i).SubItems(1)
.Fields("goodsstandard") = lstBillDocu.ListItems(i).SubItems(2)
.Fields("goodscount") = lstBillDocu.ListItems(i).SubItems(3)
.Fields("unit") = lstBillDocu.ListItems(i).SubItems(4)
.Fields("money") = lstBillDocu.ListItems(i).SubItems(5)
.Fields("sellprice") = lstBillDocu.ListItems(i).SubItems(6)
.Fields("brand") = lstBillDocu.ListItems(i).SubItems(7)
.Fields("goodssort") = lstBillDocu.ListItems(i).SubItems(8)
.Fields("producehere") = lstBillDocu.ListItems(i).SubItems(9)
.Fields("replacecoding") = lstBillDocu.ListItems(i).SubItems(10)
.Fields("goodspricemoney") = GoodsPriceMoney
.Update
End With
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?