📄 frmsale_old.frm
字号:
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 8
Left = 4980
Locked = -1 'True
TabIndex = 5
Top = 600
Width = 1695
End
Begin VB.TextBox txtFields
Alignment = 1 'Right Justify
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 9
Left = 1140
TabIndex = 1
Text = "1.00"
Top = 360
Visible = 0 'False
Width = 975
End
Begin VB.TextBox txtFields
Alignment = 1 'Right Justify
BeginProperty DataFormat
Type = 1
Format = "#,##0.00"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 7
Left = 2220
TabIndex = 4
Top = 180
Width = 1695
End
Begin VB.TextBox txtFields
Alignment = 1 'Right Justify
BeginProperty DataFormat
Type = 1
Format = "#,##0.00"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 6
Left = 2220
Locked = -1 'True
TabIndex = 3
Top = 600
Width = 1695
End
Begin VB.TextBox txtFields
Alignment = 1 'Right Justify
BeginProperty DataFormat
Type = 1
Format = "#,##0.00"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 5
Left = 4980
Locked = -1 'True
TabIndex = 2
Top = 180
Width = 1695
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "销售日期"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 11
Left = 6840
TabIndex = 22
Top = 660
Width = 945
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "业务员"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 10
Left = 6780
TabIndex = 20
Top = 240
Width = 855
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "折扣"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 9
Left = 150
TabIndex = 19
Top = 405
Visible = 0 'False
Width = 855
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "找零"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 8
Left = 4080
TabIndex = 18
Top = 600
Width = 855
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "现金"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 7
Left = 1380
TabIndex = 17
Top = 240
Width = 855
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "支票"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 6
Left = 1380
TabIndex = 16
Top = 660
Width = 855
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "应收"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 5
Left = 4020
TabIndex = 15
Top = 240
Width = 945
End
End
End
Attribute VB_Name = "frmSale"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rstmp As New ADODB.Recordset
Dim x As New XArrayDB '从表1
Dim intFormState As Integer '标示窗体的状态，“正常/浏览/新增/编辑”
Dim arrTemp() As Variant
Dim strDate As String
Dim blnIsModified As Boolean '是否有输入或修改数据 True for changed
Public Sub cmdAddNew_Click()
Dim i As Integer
If Not checkpermission("书店管理系统", strUserName, , "销售管理.零售管理.图书零售.新增") Then
Exit Sub
End If
If blnIsModified And intFormState = modEdit Then
If MsgBox("当前内容有修改，要放弃吗？", vbOKCancel, "警告") <> vbOK Then
Exit Sub
End If
End If
setFormState (modadd)
clearAll
'获取最大单号
Txtfields(0).Text = GetMaxNo("chrSellNo", "SellTable", strDate)
Txtfields(10).Text = strUserName
Txtfields(11).Text = Format(Date, "yyyy-MM-dd")
cmbFields(0).Text = strStorage
TdbSale.SetFocus
TdbSale.row = 0
blnIsModified = False
End Sub
Public Sub cmdDelete_Click()
On Error GoTo DelErr
Dim sqlstring As String
Dim rstmp As New ADODB.Recordset
Dim rsNewTmp As New ADODB.Recordset
If Not checkpermission("书店管理系统", strUserName, , "销售管理.零售管理.图书零售.删除") Then
Exit Sub
End If
If Txtfields(0).Text = "" Then
MsgBox "请录入要删除的销售单号！", vbInformation
Exit Sub
End If
cN.BeginTrans
sqlstring = "select t1.*,chrStorageNo from SellTable_List t1 left join SellTable t2 on " & _
" t1.chrSellNo=t2.chrSellNo where t1.chrSellNo='" & Txtfields(0).Text & "'"
Set rsNewTmp = New ADODB.Recordset
rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
Do While Not rsNewTmp.EOF
sqlstring = "select * from BookStorage where chrBookNo='" & rsNewTmp.Fields("chrBookNo") & _
"' and chrBookName='" & rsNewTmp.Fields("chrBookName") & "' and chrStorageNo='" & _
rsNewTmp.Fields("chrStorageNo").Value & "'"
Set rstmp = New ADODB.Recordset
rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
'库存中没有该图书的记录
If rstmp.EOF Then
MsgBox "库存表中没有图书" & rsNewTmp.Fields("chrBookNo") & " " & rsNewTmp.Fields("chrBookName") & _
"的记录", , "警告"
cN.RollbackTrans
Exit Sub
Else
sqlstring = "Update BookStorage set IntAmount=" & rstmp.Fields("IntAmount") + rsNewTmp.Fields("intAmount") & _
" where chrBookNo='" & rstmp.Fields("chrBookNo") & "' and chrBookName='" & rstmp.Fields("chrBookName") & _
"' and chrStorageNo='" & rstmp.Fields("chrStorageNo") & "'"
cN.Execute (sqlstring)
End If
rsNewTmp.MoveNext
Loop
'删除主表
sqlstring = "delete from SellTable where chrSellNo='" & Txtfields(0).Text & "'"
cN.Execute sqlstring
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -