📄 frm月库存结帐.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frm月库存结帐
BorderStyle = 3 'Fixed Dialog
Caption = "月库存结帐"
ClientHeight = 3465
ClientLeft = 45
ClientTop = 330
ClientWidth = 5580
Icon = "frm月库存结帐.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 3465
ScaleWidth = 5580
ShowInTaskbar = 0 'False
Begin VB.TextBox txtMsg
Appearance = 0 'Flat
BackColor = &H80000018&
Height = 345
Left = 840
TabIndex = 8
Top = 1425
Width = 3885
End
Begin MSComDlg.CommonDialog dlgPrinter
Left = 2550
Top = 2205
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton cmdSet
Caption = "打印设置[&O]"
Height = 525
Left = 975
TabIndex = 7
Top = 2085
Width = 1410
End
Begin VB.CommandButton cmdExit
Caption = "退出[&X]"
Height = 525
Left = 3195
TabIndex = 6
Top = 2790
Width = 1410
End
Begin VB.CommandButton cmdSave
Caption = "结帐[&S]"
Height = 525
Left = 960
TabIndex = 5
Top = 2805
Width = 1410
End
Begin VB.CommandButton cmdReport
Caption = "报表[&R]"
Height = 525
Left = 3210
TabIndex = 4
Top = 2085
Width = 1410
End
Begin MSComCtl2.DTPicker dtpTDate
Height = 345
Left = 3000
TabIndex = 1
Top = 720
Width = 1710
_ExtentX = 3016
_ExtentY = 609
_Version = 393216
Format = 23855104
CurrentDate = 36580
End
Begin MSComCtl2.DTPicker dtpLDate
Height = 345
Left = 825
TabIndex = 0
Top = 720
Width = 1710
_ExtentX = 3016
_ExtentY = 609
_Version = 393216
Format = 23855104
CurrentDate = 36580
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "本月结帐日期"
Height = 180
Left = 3180
TabIndex = 3
Top = 315
Width = 1080
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "上月结帐日期"
Height = 180
Left = 900
TabIndex = 2
Top = 285
Width = 1080
End
End
Attribute VB_Name = "frm月库存结帐"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdReport_Click()
On Error Resume Next
If envDStar.rscmd月库存商品帐.State = adStateOpen Then
envDStar.rscmd月库存商品帐.Close
End If
sSQL = " SELECT * FROM 月结报表 WHERE 结帐日期='" & Format(dtpTDate.Value, "YYYY-MM-DD") & "'"
envDStar.Commands("cmd月库存商品帐").CommandText = sSQL
envDStar.Commands("cmd月库存商品帐").Execute
envDStar.rscmd月库存商品帐.Open
rpt月结报表.Show
End Sub
Private Sub cmdSave_Click()
'上月结存:上月盘点结存数量
'本期购进:经销进货+代销进货-经销退货-代销退货(有效数量)
'本期发出:销售-销售退货+配送-配送返货-盘点长货+盘点短货
'
'上月结存+本期购进-本期发出=本期结存
On Error GoTo SaveErr
Conn.BeginTrans
sSQL = "SELECT 编码,结存数量 FROM 月结报表 WHERE 结帐日期='" & Format(dtpTDate.Value, "YYYY-MM-DD") & "'"
Set RsTemp = Nothing
RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
If Not RsTemp.EOF Then
If MsgBox("已存在本日的汇总，删除吗？", vbQuestion + vbYesNo, "提示窗口") = vbNo Then
Conn.RollbackTrans
Exit Sub
Else
sSQL = "DELETE 月结报表 WHERE 结帐日期='" & Format(dtpTDate.Value, "YYYY-MM-DD") & "'"
Cmd.ActiveConnection = Conn
Cmd.CommandText = sSQL
Cmd.Execute
End If
End If
txtMsg.Text = "正在汇总本月数据......"
sSQL = "INSERT INTO 月结报表(编码,品名,单价,结帐日期,结存数量,金额) " & _
" SELECT A.商品编码,A.品名,A.进价,'" & Format(dtpTDate.Value, "YYYY-MM-DD") & "' AS 结帐日期,B.数量,B.进价金额 " & _
" FROM 商品主档 AS A INNER JOIN 配送中心库存 AS B ON A.商品编码=B.商品编码"
Cmd.ActiveConnection = Conn
Cmd.CommandText = sSQL
Cmd.Execute
txtMsg.Text = "正在汇总上月结存数据......"
If dtpLDate.Value = dtpTDate.Value Then
If MsgBox("上月结存日期和本期结帐日期一致，上月结存数将采用本期库存进行汇总，继续吗？", vbQuestion + vbYesNo, "提示窗口") = vbYes Then
sSQL = "UPDATE 月结报表 SET 上月结存=结存数量 WHERE 结帐日期='" & Format(dtpTDate.Value, "YYYY-MM-DD") & "'"
Cmd.CommandText = sSQL
Cmd.Execute
Else
Conn.RollbackTrans
Exit Sub
End If
End If
sSQL = "SELECT 编码,结存数量 FROM 月结报表 WHERE 结帐日期='" & Format(dtpLDate.Value, "YYYY-MM-DD") & "'"
Set RsTemp = Nothing
RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
While Not RsTemp.EOF
sSQL = "UPDATE 月结报表 SET 上月结存=" & RsTemp("结存数量") & " WHERE 编码='" & Trim(RsTemp("编码")) & "' AND 结帐日期='" & Format(dtpTDate.Value, "YYYY-MM-DD") & "'"
Cmd.CommandText = sSQL
Cmd.Execute
RsTemp.MoveNext
Wend
txtMsg.Text = "正在汇总本期购进数据......"
sSQL = "SELECT 商品编码,SUM(进货数量) AS 进货数量 FROM 经销进货单 WHERE 制表日期 BETWEEN '" & Format(DateAdd("D", 1, dtpLDate.Value), "YYYY-MM-DD") & "'" & _
" AND '" & Format(dtpTDate.Value, "YYYY-MM-DD") & "' GROUP BY 商品编码"
Set RsTemp = Nothing
RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
While Not RsTemp.EOF
sSQL = "UPDATE 月结报表 SET 本期购进=" & RsTemp("进货数量") & " WHERE 编码='" & Trim(RsTemp("商品编码")) & "' AND 结帐日期='" & Format(dtpTDate.Value, "YYYY-MM-DD") & "'"
Cmd.CommandText = sSQL
Cmd.Execute
RsTemp.MoveNext
Wend
txtMsg.Text = "正在汇总本期退货数据......"
sSQL = "SELECT 商品编码,SUM(进货数量) AS 进货数量 FROM 经销退货单 WHERE 制表日期 BETWEEN '" & Format(DateAdd("D", 1, dtpLDate.Value), "YYYY-MM-DD") & "'" & _
" AND '" & Format(dtpTDate.Value, "YYYY-MM-DD") & "' GROUP BY 商品编码"
Set RsTemp = Nothing
RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
While Not RsTemp.EOF
sSQL = "UPDATE 月结报表 SET 本期购进=本期购进-" & RsTemp("进货数量") & " WHERE 编码='" & Trim(RsTemp("商品编码")) & "' AND 结帐日期='" & Format(dtpTDate.Value, "YYYY-MM-DD") & "'"
Cmd.CommandText = sSQL
Cmd.Execute
RsTemp.MoveNext
Wend
txtMsg.Text = "正在汇总连锁店本期配送数据......"
sSQL = "SELECT 商品编码,SUM(配送数量) AS 配送数量 FROM 商品配送单 WHERE 配送日期 BETWEEN '" & Format(DateAdd("D", 1, dtpLDate.Value), "YYYY-MM-DD") & "'" & _
" AND '" & Format(dtpTDate.Value, "YYYY-MM-DD") & "' GROUP BY 商品编码"
Set RsTemp = Nothing
RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
While Not RsTemp.EOF
sSQL = "UPDATE 月结报表 SET 本期发出=" & RsTemp("配送数量") & " WHERE 编码='" & Trim(RsTemp("商品编码")) & "' AND 结帐日期='" & Format(dtpTDate.Value, "YYYY-MM-DD") & "'"
Cmd.CommandText = sSQL
Cmd.Execute
RsTemp.MoveNext
Wend
txtMsg.Text = "正在汇总连锁店本期配送返货数据......"
sSQL = "SELECT 商品编码,SUM(配送数量) AS 配送数量 FROM 分店返货单 WHERE 配送日期 BETWEEN '" & Format(DateAdd("D", 1, dtpLDate.Value), "YYYY-MM-DD") & "'" & _
" AND '" & Format(dtpTDate.Value, "YYYY-MM-DD") & "' GROUP BY 商品编码"
Set RsTemp = Nothing
RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
While Not RsTemp.EOF
sSQL = "UPDATE 月结报表 SET 本期发出=本期发出-" & RsTemp("配送数量") & " WHERE 编码='" & Trim(RsTemp("商品编码")) & "' AND 结帐日期='" & Format(dtpTDate.Value, "YYYY-MM-DD") & "'"
Cmd.CommandText = sSQL
Cmd.Execute
RsTemp.MoveNext
Wend
txtMsg.Text = "正在汇总商品盘点数据......"
sSQL = "SELECT 商品编码,SUM(盘亏数量) AS 数量 FROM 盘点盈亏报告单 WHERE 制表日期 BETWEEN '" & Format(DateAdd("D", 1, dtpLDate.Value), "YYYY-MM-DD") & "'" & _
" AND '" & Format(dtpTDate.Value, "YYYY-MM-DD") & "' AND 盘点部门='配送中心'" & _
" GROUP BY 商品编码"
Set RsTemp = Nothing
RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
While Not RsTemp.EOF
sSQL = "UPDATE 月结报表 SET 本期发出=本期发出-(" & RsTemp("数量") & ") WHERE 编码='" & Trim(RsTemp("商品编码")) & "' AND 结帐日期='" & Format(dtpTDate.Value, "YYYY-MM-DD") & "'"
Cmd.CommandText = sSQL
Cmd.Execute
RsTemp.MoveNext
Wend
txtMsg.Text = "正在汇总配送中心本期销售数据......"
sSQL = "SELECT 商品编码,SUM(数量) AS 销售数量 FROM 批发单 WHERE 制表日期 BETWEEN '" & Format(DateAdd("D", 1, dtpLDate.Value), "YYYY-MM-DD") & "'" & _
" AND '" & Format(dtpTDate.Value, "YYYY-MM-DD") & "' AND 确认状态=1 GROUP BY 商品编码"
Set RsTemp = Nothing
RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
While Not RsTemp.EOF
sSQL = "UPDATE 月结报表 SET 本期发出=本期发出+" & RsTemp("销售数量") & " WHERE 编码='" & Trim(RsTemp("商品编码")) & "' AND 结帐日期='" & Format(dtpTDate.Value, "YYYY-MM-DD") & "'"
Cmd.CommandText = sSQL
Cmd.Execute
RsTemp.MoveNext
Wend
Conn.CommitTrans
txtMsg.Text = "汇总数据成功!!!"
MsgBox "汇总数据成功!!!", vbInformation, "提示窗口"
Exit Sub
SaveErr:
Conn.RollbackTrans
MsgBox "保存发生错误!!!", vbExclamation, "错误窗口"
End Sub
Private Sub cmdSet_Click()
dlgPrinter.ShowPrinter
End Sub
Private Sub Form_Load()
On Error Resume Next
Call SetFormToCenter(Me)
dtpLDate.Value = DateAdd("M", -1, Now)
dtpTDate.Value = Now
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -