📄 frmbackstock.frm
字号:
_ExtentY = 714
Caption = "查 询"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin MSComCtl2.DTPicker dtp2
Height = 315
Left = 3390
TabIndex = 13
Top = 240
Width = 2235
_ExtentX = 3942
_ExtentY = 556
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Format = 49545217
CurrentDate = 37700
End
Begin MSComCtl2.DTPicker dtp1
Height = 315
Left = 690
TabIndex = 14
Top = 240
Width = 2235
_ExtentX = 3942
_ExtentY = 556
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Format = 49545217
CurrentDate = 37700
End
Begin VB.Label Label1
Caption = "由"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 420
TabIndex = 17
Top = 300
Width = 285
End
Begin VB.Label Label2
Caption = "至"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3030
TabIndex = 16
Top = 300
Width = 225
End
Begin VB.Label Label3
Caption = "期间"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 5760
TabIndex = 15
Top = 300
Width = 420
End
Begin VB.Line Line2
BorderColor = &H00FFFFFF&
Index = 1
X1 = 8670
X2 = 8670
Y1 = 60
Y2 = 1200
End
Begin VB.Line Line1
BorderColor = &H00C0C0C0&
Index = 0
X1 = 90
X2 = 8670
Y1 = 60
Y2 = 60
End
Begin VB.Line Line1
BorderColor = &H00FFFFFF&
Index = 1
X1 = 60
X2 = 8670
Y1 = 1170
Y2 = 1170
End
Begin VB.Line Line2
BorderColor = &H00C0C0C0&
Index = 0
X1 = 60
X2 = 60
Y1 = 60
Y2 = 1200
End
End
Attribute VB_Name = "frmBackStock"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub chk_Click()
If chk.Value = 1 Then
txtValue.Enabled = True
txtValue.BackColor = &H80000005
dtp1.Enabled = False
dtp2.Enabled = False
Else
txtValue.Text = ""
txtValue.Enabled = False
txtValue.BackColor = &H8000000F
dtp1.Enabled = True
dtp2.Enabled = True
End If
End Sub
Private Sub cmdCancel_Click()
Grid.Height = 4755
cmdMinus.Enabled = True
cmdExec.Enabled = True
Grid.Enabled = True
pic.Visible = False
End Sub
Private Sub cmdExec_Click()
Dim SQL As String
If chk.Value = 0 Then
SQL = "select ruku_id,yaopin_id,name,unit,inprice,num,gongying from v_ruku_list where indate between '" _
& Format(dtp1.Value, "yyyy-mm-dd") & "' and '" & Format(dtp2.Value, "yyyy-mm-dd") & "'"
Else
SQL = "select ruku_id,yaopin_id,name,unit,inprice,num,gongying from v_ruku_list where ruku_id='" & txtValue.Text & "'"
End If
FillGrid " 入 库 单 |^ 商 品 编 码 |^ 商 品 名 称 |^ 单 位 |^ 进 价 |^ 数 量 |^ 供 应 商 ", SQL, Grid, 7
End Sub
Private Sub cmdMinus_Click()
If Grid.Rows = 1 Or Grid.Text = "" Then Exit Sub
cmdMinus.Enabled = False
cmdExec.Enabled = False
Grid.Enabled = False
pic.Visible = True
Grid.Height = 3435
lblID.Caption = Grid.TextMatrix(Grid.RowSel, 0)
lblYaopin_id.Caption = Grid.TextMatrix(Grid.RowSel, 1)
lblName.Caption = Grid.TextMatrix(Grid.RowSel, 2)
lblUnit.Caption = Grid.TextMatrix(Grid.RowSel, 3)
txtNum.Text = Grid.TextMatrix(Grid.RowSel, 5)
txtNum.SelStart = 0
txtNum.SelLength = Len(txtNum.Text)
txtNum.SetFocus
End Sub
Private Sub cmdSave_Click()
If IsNumeric(txtNum.Text) = False Then MsgBox "您填写的退货数量不是有效的数字！", 64: Exit Sub
If Val(txtNum.Text) > Val(Grid.TextMatrix(Grid.RowSel, 5)) Then
MsgBox "您对退货数量的更改有误！", 64
txtNum.Text = Grid.TextMatrix(Grid.RowSel, 5)
Exit Sub
End If
Dim Cmd As ADODB.Command
Dim Rst As ADODB.Recordset
Dim SQL As String
Dim Minus As Currency
SQL = "select num from yaopin_num where id='" & lblYaopin_id.Caption & "'"
Set Rst = New ADODB.Recordset
Rst.CursorLocation = adUseClient
Rst.Open SQL, Conn, adOpenDynamic, adLockReadOnly, adCmdText
If Rst.EOF Then MsgBox "数据库出错！", 16: Exit Sub
If Val(txtNum.Text) > Val(Rst.Fields(0)) Then
MsgBox " 当前库存量小于您所要求的退货量，可能是该批次商品已经在销售中。" _
& vbCrLf & "因此不能按你要求的数额退货！" & vbCrLf & _
" 当前库存为：" & CStr(Rst.Fields(0)) & vbCrLf & " " & _
"您可以：更改库存 或者 削减退货数量。"
Set Rst = Nothing
Exit Sub
End If
Set Rst = Nothing
If Trim(txtNum.Text) = Grid.TextMatrix(Grid.RowSel, 5) Then
SQL = "execute stock_backing_del "
Else
SQL = "execute stock_backing "
End If
SQL = SQL + " '" & lblID.Caption & "','" & lblYaopin_id.Caption _
& "','" & lblUnit.Caption & "'," & Grid.TextMatrix(Grid.RowSel, 4) & "," & _
txtNum.Text & ",'" & Grid.TextMatrix(Grid.RowSel, 6) & "','" & _
Format(Date$, "yyyy-mm-dd") & "','" & Format(Time$, "hh:mm:ss") & "','" & UserName & "'"
Set Cmd = New ADODB.Command
Cmd.ActiveConnection = Conn
Cmd.CommandText = SQL
Cmd.CommandType = adCmdText
Cmd.Execute
Set Rst = New ADODB.Recordset
Rst.CursorLocation = adUseClient
SQL = "select * from yingfu_list where id='" & Grid.TextMatrix(Grid.RowSel, 0) & "'"
Rst.Open SQL, Conn, adOpenDynamic, adLockReadOnly, adCmdText
If Not Rst.EOF Then
If MsgBox(" 应付账款记录表中包含应付供应商：" & Rst.Fields(1) & "应付账款：" _
& Rst.Fields(2) & "元。" _
& vbCrLf & "该笔账款将自动冲减，否则有可能造成帐目的混乱。" & _
" 您是否同意？（是/否）", vbQuestion + vbYesNo) = vbYes Then
Minus = Val(txtNum.Text) * Val(Grid.TextMatrix(Grid.RowSel, 5))
Cmd.CommandText = "update yingfu_list set yingfu=yingfu - " & CStr(Minus) & _
",yifu=yifu + " & CStr(Minus) & " where id='" & Grid.TextMatrix(Grid.RowSel, 0) & "'"
Cmd.CommandType = adCmdText
Cmd.Execute
If Minus > Val(Rst.Fields(2)) Then
If MsgBox("当前应付账款小于退货账款，因此将删除该笔应付账记录，否则可能造成应付款为负！您是否同意？（是/否）", _
vbYesNo + vbQuestion) = vbYes Then
Cmd.CommandText = "delete from yingfu_list where yingfu < 0"
Cmd.CommandType = adCmdText
Cmd.Execute
End If
End If
End If
End If
Set Rst = Nothing
Set Cmd = Nothing
If Trim(txtNum.Text) = Grid.TextMatrix(Grid.RowSel, 5) Then
If Grid.Rows = 2 Then
Grid.Clear
Grid.FormatString = " 入 库 单 |^ 商 品 编 码 |^ 商 品 名 称 |^ 单 位 |^ 进 价 |^ 数 量 |^ 供 应 商 "
Else
Grid.RemoveItem Grid.RowSel
End If
Else
Grid.TextMatrix(Grid.RowSel, 5) = CStr(Val(Grid.TextMatrix(Grid.RowSel, 5)) - Val(txtNum.Text))
End If
Grid.Height = 4755
cmdMinus.Enabled = True
cmdExec.Enabled = True
Grid.Enabled = True
pic.Visible = False
MsgBox "退货成功！", 64
End Sub
Private Sub Form_Load()
dtp1.Value = Date$
dtp2.Value = Date$
txtValue.Enabled = False
Grid.Width = 8625
Grid.Height = 4755
txtValue.BackColor = &H8000000F
pic.Visible = False
End Sub
Private Sub txtNum_KeyPress(KeyAscii As Integer)
If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 And KeyAscii <> 46 Then KeyAscii = 0
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -