📄 productmove3.frm
字号:
VERSION 5.00
Begin VB.Form ProductMove3
AutoRedraw = -1 'True
BorderStyle = 3 'Fixed Dialog
Caption = "产品调拨完成"
ClientHeight = 3390
ClientLeft = 45
ClientTop = 330
ClientWidth = 5610
Icon = "ProductMove3.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3390
ScaleWidth = 5610
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
Begin VB.PictureBox Report1
Height = 480
Left = 630
ScaleHeight = 420
ScaleWidth = 1140
TabIndex = 8
Top = 3405
Width = 1200
End
Begin VB.CommandButton AgainDb
Caption = "再调拨(&A)"
Height = 420
Left = 2760
TabIndex = 1
Top = 2565
Width = 1200
End
Begin VB.CommandButton OK
Caption = "完成(&S)"
Default = -1 'True
Height = 420
Left = 4020
TabIndex = 0
Top = 2565
Width = 1275
End
Begin VB.PictureBox Picture1
BackColor = &H00808000&
Height = 2865
Left = 255
ScaleHeight = 2805
ScaleWidth = 1830
TabIndex = 2
Top = 270
Width = 1890
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "?"
BeginProperty Font
Name = "宋体"
Size = 42
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFF80&
Height = 705
Left = 1275
TabIndex = 3
Top = 240
Width = 705
End
Begin VB.Image Image2
Height = 1935
Left = -60
Picture = "ProductMove3.frx":08CA
Stretch = -1 'True
Top = 735
Width = 1905
End
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "调拨单"
ForeColor = &H00008000&
Height = 180
Left = 4380
TabIndex = 7
Top = 2160
Width = 540
End
Begin VB.Image PrintDB
Height = 480
Left = 4425
MouseIcon = "ProductMove3.frx":2A4E
MousePointer = 99 'Custom
Picture = "ProductMove3.frx":2D58
ToolTipText = "打印调拨单"
Top = 1590
Width = 480
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "第三步"
ForeColor = &H000000FF&
Height = 180
Left = 2490
TabIndex = 6
Top = 330
Width = 540
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "OK"
BeginProperty Font
Name = "黑体"
Size = 42
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 840
Left = 2745
TabIndex = 5
Top = 1620
Width = 885
End
Begin VB.Label Label2
Caption = "恭喜您,已经按您的意思进行两仓库间的产品调拨,如果您还要进行调拨,请按再调拨,否则按完成按钮,结束产品调拨。"
Height = 780
Left = 2505
TabIndex = 4
Top = 675
Width = 2820
End
End
Attribute VB_Name = "ProductMove3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub AgainDb_Click()
Unload Me
MDIForm1.MousePointer = 0
ProductMove.Show 1
End Sub
Private Sub Form_Load()
Dim DB As Database, Ef As Recordset, TempStr As String, EStr As String, TempNumber As Single, ProductT As String
Dim FG As Recordset, DWStr As String, MCStr As String
Set DB = OpenDatabase(App.Path & "\Sys\Store.mdb", 0, 0, Constr)
Set Ef = DB.OpenRecordset("DbKTemp", dbOpenDynaset)
Set FG = DB.OpenRecordset("KCK", dbOpenDynaset)
Do Until Ef.EOF
If Not IsNull(Ef.Fields(3).Value) Then
TempStr = Ef.Fields(3).Value
MCStr = TempStr
If Not IsNull(Ef.Fields(4).Value) Then
TempNumber = Ef.Fields(4).Value
End If
If Not IsNull(Ef.Fields(8).Value) Then
ProductT = Ef.Fields(8).Value
End If
If Not IsNull(Ef.Fields(9).Value) Then
DWStr = Ef.Fields(9).Value
End If
'更新源仓库
EStr = "Update KCK set 数量=数量-" & TempNumber & " Where 仓库类型='" & ResourceCK & "' and 产品类型='" & ProductT & "' and 产品名称='" & MCStr & "'"
DB.Execute EStr
End If
'查找目标库存中有无此记录
TempStr = "仓库类型='" & ObjectCK & "' and 产品名称='" & TempStr & "' and 产品类型='" & ProductT & "'"
FG.FindFirst TempStr
If FG.NoMatch Then
'增加记录
EStr = "Insert into KCK (仓库类型,产品类型,产品名称,单位,数量) Values('" & ObjectCK & "','" & ProductT & "','" & MCStr & "','" & DWStr & "'," & TempNumber & ")"
DB.Execute EStr
Else
'更新记录
EStr = "Update KCK set 数量=数量+" & TempNumber & " Where 仓库类型='" & ObjectCK & "' and 产品类型='" & ProductT & "' and 产品名称='" & MCStr & "'"
DB.Execute EStr
End If
'插入今日调拨库
Ef.MoveNext
If Ef.EOF Then
Exit Do
End If
Loop
EStr = "Delete * From DayDbk"
DB.Execute EStr
EStr = "Insert Into DayDbk Select * From DbkTemp"
DB.Execute EStr
EStr = "Update DayDbk set 原仓库='" & ResourceCK & "', 目标仓库='" & ObjectCK & "',日期=#" & Date & "#,经手人='" & UserText & "'"
DB.Execute EStr
Dim DjH As String
Set Ef = DB.OpenRecordset("Dbk", dbOpenDynaset)
On Error GoTo NoRecord
Ef.MoveLast
If Not IsNull(Ef.Fields(0).Value) Then
DjH = Ef.Fields(0).Value
Else
DjH = 1999000000
End If
GoTo HaveRecord
NoRecord:
DjH = 1999000000
HaveRecord:
Set Ef = DB.OpenRecordset("DayDbK", dbOpenDynaset)
Do Until Ef.EOF
If Not IsNull(Ef.Fields(3).Value) Then
MCStr = Ef.Fields(3).Value
End If
If Not IsNull(Ef.Fields(8).Value) Then
ProductT = Ef.Fields(8).Value
End If
EStr = "Update DayDbk set 单据编号='" & DjH & "' Where 产品名称='" & MCStr & "' and 产品类型='" & ProductT & "'"
DB.Execute EStr
Ef.MoveNext
DjH = DjH + 1
Loop
EStr = "Insert into DbK Select * From DayDbk"
DB.Execute EStr
DB.Close
End Sub
Private Sub OK_Click()
MDIForm1.MousePointer = 0
Unload Me
End Sub
Private Sub PrintDB_Click()
ProductMove3.MousePointer = 11
Report1.ReportFileName = Browser + "report\DayDBK.rpt"
Report1.DataFiles(0) = ConData3
Report1.DataFiles(1) = ConData2
On Error Resume Next
Report1.WindowState = crptNormal
Report1.PrintReport
ProductMove3.MousePointer = 0
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -