📄 frmsell.frm
字号:
Case vbKeyF2
FrmSPLB.Show 1
Case vbKeyF3
If MsgBox("请确信要取消此单?", vbOKCancel + vbCritical, "提示") = vbOK Then
Call ReSet
End If
Case vbKeyF8
If Grid.Rows <= 1 Then Exit Sub
Dim Rst1, Rst2, KCRst As ADODB.Recordset
Dim NumId, id As Integer
'
' If TxtSHR.Caption = "" Then
' MsgBox "请选择收货人（单位）！", vbOKOnly + 48, "提示"
' Exit Sub
' End If
' If Combo1.Text = "" Then
' MsgBox "请选择付款方式！", vbOKOnly + vbCritical, "提示"
' Exit Sub
' Else
' If Combo1.Text = "现金" Then
' JZF = 1
' Else
' JZF = 0
' End If
' End If
If Combo1.Text = "" Then
MsgBox "请选择收货公司！", vbOKOnly + vbCritical, "提示"
Exit Sub
End If
For I = 1 To Grid.Rows - 1
If Grid.TextMatrix(I, 5) = "0" Then
MsgBox "第" & I & "行'数量'不能为零！", vbOKOnly + vbExclamation, "警告"
Exit Sub
ElseIf Grid.TextMatrix(I, 6) = "0.00" Then
MsgBox "第" & I & "行'单价'不能为零！", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
Next I
'更新入库单总表，插入一条
'--------------------------------------------------------------------------------------
'Set Rst = New ADODB.Recordset
SQL = "insert into 销售总表 values ('" & txtNo.Text & "','" _
& Combo1.Text & "','" & Format(DTPicker1.Value, "yyyy-mm-dd") & "','" & Format(DTPicker2.Value, "yyyy-mm-dd") & "'," & _
lblJE.Caption & "," & lblSE.Caption & "," & lblJSHJ.Caption & ",'0' )"
'Rst.Open SQL, db, 1, 3
Set Rst = ExecuteSQL(SQL, Msgtext)
'---------------------------------------------------------------------------------------
'更新入库单明细表
'---------------------------------------------------------------------------------------
'Set Rst1 = New ADODB.Recordset
SQL = "select max(id) from 销售表"
'Rst1.Open SQL, db, 1, 3
Set Rst1 = ExecuteSQL(SQL, Msgtext)
If IsNull(Rst1.Fields(0)) Then
NumId = 0
Else
NumId = Rst1.Fields(0)
End If
'Set Rst2 = New ADODB.Recordset
For I = 1 To Grid.Rows - 1
NumId = NumId + 1
SQL = "insert into 销售表 values('" & NumId & "','" & Trim(txtNo) & "','" & Grid.TextMatrix(I, 0) & "','" _
& Grid.TextMatrix(I, 1) & "','" & Grid.TextMatrix(I, 2) & "','" & Grid.TextMatrix(I, 3) & "','" _
& Grid.TextMatrix(I, 4) & "','" & Grid.TextMatrix(I, 5) & "'," & Grid.TextMatrix(I, 6) & "," _
& Grid.TextMatrix(I, 7) & "," & Grid.TextMatrix(I, 8) & "," & Grid.TextMatrix(I, 9) & "," _
& Grid.TextMatrix(I, 10) & ",'" & Grid.TextMatrix(I, 11) & "')"
'Rst2.Open SQL, db, 1, 3
Set Rst2 = ExecuteSQL(SQL, Msgtext)
'更新动态库存表
'---------------------------------------------------------------------------------------
' Set KCRst = New ADODB.Recordset
' SQL = "update kcdtb set sl=sl-" & Val(Grid.TextMatrix(I, 5)) & " where spid=" & Grid.TextMatrix(I, 11)
' KCRst.Open SQL, db, 1, 3
' KCRst.Fields(4) = KCRst.Fields(4) - Val(Grid.TextMatrix(I, 5))
' KCRst.Update
'---------------------------------------------------------------------------------------
Next
'---------------------------------------------------------------------------------------
If ButtonFlag = 1 Then
If MsgBox("数据保存成功,是否要打印?", vbOKCancel + vbInformation, "提示") = vbOK Then
Call FPPrint
End If
ElseIf ButtonFlag = 2 Then
MsgBox "数据保存成功,正在打印！", , "提示"
Call FPPrint
End If
'Combo1.Text = ""
Call ReSet
Number = Number + 1
'LblFPHM.Caption = Format(Date$, "yymmdd") & Format(CStr(Number), "000")
Case vbKeyF10
If Grid.Rows <= 1 Then
MsgBox "数据内容为空，不能打印！", vbOKOnly + vbCritical, "警告"
Exit Sub
End If
Call FPPrint
'Call Grid_KeyUp(vbKeyF8, 0)
Case vbKeyDelete, vbKeyBack
Dim SumJE, SumSE, SumJSHJ As Currency
Dim SumSL As Integer
If Grid.RowSel = 0 Then Exit Sub
If Grid.Rows = 2 Then ReSet: Exit Sub
IDlist.Remove Grid.RowSel
Grid.RemoveItem Grid.RowSel
For I = 1 To Grid.Rows - 1
SumJE = SumJE + Val(Grid.TextMatrix(I, 7))
SumSE = SumSE + Val(Grid.TextMatrix(I, 9))
SumJSHJ = SumJSHJ + Val(Grid.TextMatrix(I, 10))
SumSL = SumSL + Val(Grid.TextMatrix(I, 5))
Next
lblJE.Caption = Format(CStr(SumJE), "##0.00")
lblSE.Caption = Format(CStr(SumSE), "##0.00")
lblJSHJ.Caption = Format(CStr(SumJSHJ), "##0.00")
lblSL.Caption = SumSL
For I = 1 To Grid.Rows - 1
Grid.TextMatrix(I, 0) = CStr(I)
Next
End Select
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case Is = "Exit"
Unload Me
Case Is = "Addline"
FrmSPLB.Show 1
Case Is = "Delline"
Call Grid_KeyUp(vbKeyDelete, 0)
Case Is = "Save"
ButtonFlag = 1
Call Grid_KeyUp(vbKeyF8, 0)
Case Is = "Print"
'ButtonFlag = 2
Call Grid_KeyUp(vbKeyF10, 0)
End Select
End Sub
'Private Sub TxtSHR_DblClick()
' Call Command2_Click
'End Sub
Private Sub FPPrint()
Dim t As Integer
Dim j As Integer
Dim N As Integer
' Dim RstKH As ADODB.Recordset
' On Error GoTo Errorhandler
Set XSDExcel = New Excel.Application
XSDExcel.Visible = True
'Set XSDExcel = Nothing
XSDExcel.SheetsInNewWorkbook = 1
Set zsbworkbook = XSDExcel.Workbooks.Open(App.Path + "\" + "sheet\销售单.xlt")
With XSDExcel.ActiveSheet
'--------------------------------------填充客户资料
'Set RstKH = New Recordset
' SQL = "select * from customer where cn_CompanyName='" & Trim(Me.Combo1.Text) & "'"
' 'RstKH.Open SQL, Db, 1, 3
' Set RstKH = ExecuteSQL(SQL, MsgText)
'
'
' .Range("F3").Value = RstKH.Fields(1)
' .Range("F4").Value = RstKH.Fields(2)
' .Range("F5").Value = RstKH.Fields(3)
' .Range("F6").Value = "M.B.: " & RstKH.Fields(4)
'
' RstKH.Close
' Set RstKH = Nothing
'-----------------------------------------
' If Combo1.Text = "现金" Then
' .Range("D9").Value = "GOTOVINA"
' Else
' .Range("D9").Value = "Waiting...."
' End If
.Range("C4").Value = Me.Combo1.Text
.Range("G4").Value = Me.txtNo
.Range("C6").Value = Format(Me.DTPicker1, "yyyy-mm-dd")
.Range("G6").Value = Format(Me.DTPicker2, "yyyy-mm-dd")
.Range("C33").Value = Me.lblSL
.Range("F33").Value = Me.lblJE
.Range("C35").Value = Me.lblSE
.Range("F35").Value = Me.lblJSHJ
For t = 1 To Grid.Rows - 1
a = "A" + CStr(t + 8)
b = "B" + CStr(t + 8)
d = "D" + CStr(t + 8)
e = "E" + CStr(t + 8)
f = "F" + CStr(t + 8)
g = "G" + CStr(t + 8)
h = "H" + CStr(t + 8)
a1 = "J" + CStr(t + 8)
.Range(a).Value = Grid.TextMatrix(t, 0)
.Range(b).Value = Grid.TextMatrix(t, 1)
.Range(d).Value = Grid.TextMatrix(t, 5)
.Range(e).Value = Grid.TextMatrix(t, 6)
.Range(f).Value = Grid.TextMatrix(t, 7)
.Range(g).Value = Grid.TextMatrix(t, 8)
.Range(h).Value = Grid.TextMatrix(t, 9)
.Range(a1).Value = Grid.TextMatrix(t, 10)
Next t
For j = 1 To Grid.Rows - 1
a1 = "A" + CStr(j + 20)
c1 = "C" + CStr(j + 20)
d1 = "D" + CStr(j + 20)
f1 = "F" + CStr(j + 20)
.Range(a1).Value = Grid.TextMatrix(j, 1)
.Range(c1).Value = Grid.TextMatrix(j, 2)
.Range(d1).Value = Grid.TextMatrix(j, 3)
.Range(f1).Value = Grid.TextMatrix(j, 4)
Next j
End With
'dd = MsgBox("yes or no", vbYesNo + vbSystemModal)
'If dd = vbNo Then Exit Sub
' XSDExcel.ActiveSheet.PageSetup.Orientation = xlPortrait 'xlLandscape
' XSDExcel.ActiveSheet.PageSetup.PaperSize = xlPaperA4
XSDExcel.Caption = "打印预览"
XSDExcel.ActiveWindow.SelectedSheets.PrintPreview
' XSDExcel.ActiveSheet.PrintOut
XSDExcel.DisplayAlerts = False
XSDExcel.Quit
XSDExcel.DisplayAlerts = True
Set XSDExcel = Nothing
Exit Sub
'Errorhandler:
' MsgBox "请正确安装EXCEL或检查打印机状况！", vbOKOnly + vbCritical
Exit Sub
End Sub
Private Sub Text1_LostFocus()
On Error GoTo Errorhandler
' Dim SumJE, SumSE, SumJSHJ As Currency
' Dim I, SumSL As Integer
Dim tmpRow As Integer
Dim tmpCol As Integer
' Save current settings of Grid Row and col. This is needed only if
' the focus is set somewhere else in the Grid.
tmpRow = Grid.Row
tmpCol = Grid.Col
' Set Row and Col back to what they were before Text1_LostFocus:
Grid.Row = gRow
Grid.Col = gCol
If gCol = 5 Then
Grid.Text = Val(Text1.Text)
'检测库存商品数量
' Dim KCSLRst As ADODB.Recordset
'
' Set KCSLRst = New ADODB.Recordset
' SQL = "select * from kcdtb where spid=" & Grid.TextMatrix(Grid.RowSel, 11)
' KCSLRst.Open SQL, db, 1, 3
'
' If IsNull(KCSLRst.Fields(4)) Or KCSLRst.EOF Then
' MsgBox "仓库中无此商品，请确认！", vbOKOnly + 48, "提示"
' GoTo MOVEOut
' End If
' If Val(KCSLRst.Fields(4)) >= Val(Text1.Text) Then
' Grid.Text = Val(Text1.Text)
' Else
' MsgBox "该商品库存数量不足！", vbOKOnly + 48, "提示"
' GoTo MOVEOut
' End If
ElseIf gCol = 6 Then
Grid.Text = Format(Val(Text1.Text), "###0.00") ' Transfer text back to grid.
ElseIf gCol = 8 Then
If MsgBox("你确信要更改ＰＤＶ？", vbOKCancel + vbCritical, "提示") = vbOK Then
Grid.Text = Val(Text1.Text)
End If
End If
Text1.SelStart = 0
Text1.Visible = False
' Return row and Col contents:
Grid.TextMatrix(Grid.RowSel, 7) = Format(Val(Grid.TextMatrix(Grid.RowSel, 6) * Grid.TextMatrix(Grid.RowSel, 5)), "0.00")
Grid.TextMatrix(Grid.RowSel, 9) = Format(Val(Grid.TextMatrix(Grid.RowSel, 7) * Grid.TextMatrix(Grid.RowSel, 8)), "0.00")
Grid.TextMatrix(Grid.RowSel, 10) = Format(Val(Val(Grid.TextMatrix(Grid.RowSel, 7)) + Val(Grid.TextMatrix(Grid.RowSel, 9))), "0.00")
For I = 1 To Grid.Rows - 1
SumJE = SumJE + Val(Grid.TextMatrix(I, 7))
SumSE = SumSE + Val(Grid.TextMatrix(I, 9))
SumJSHJ = SumJSHJ + Val(Grid.TextMatrix(I, 10))
SumSL = SumSL + Val(Grid.TextMatrix(I, 5))
Next
lblJE.Caption = Format(CStr(SumJE), "0.00")
lblSE.Caption = Format(CStr(SumSE), "0.00")
lblJSHJ.Caption = Format(CStr(SumJSHJ), "0.00")
lblSL.Caption = SumSL
Grid.Row = tmpRow
Grid.Col = tmpCol
'MOVEOut:
' Text1.SelStart = 0 ' Return caret to beginning.
' Text1.Visible = False ' Disable text box.
'
'' Grid.Row = tmpRow
'' Grid.Col = tmpCol
Exit Sub
Errorhandler:
Exit Sub
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -