📄 bsappendform.frm
字号:
VERSION 5.00
Object = "{F0D2F211-CCB0-11D0-A316-00AA00688B10}#1.0#0"; "MSDATLST.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form bsappendform
BorderStyle = 0 'None
ClientHeight = 5070
ClientLeft = 0
ClientTop = 0
ClientWidth = 5145
LinkTopic = "Form1"
Picture = "bsappendform.frx":0000
ScaleHeight = 338
ScaleMode = 3 'Pixel
ScaleWidth = 343
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Begin VB.TextBox data_j
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
Height = 270
Left = 2520
MaxLength = 25
TabIndex = 13
Top = 3645
Width = 1215
End
Begin VB.TextBox data_i
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
Height = 270
Left = 2520
MaxLength = 25
TabIndex = 12
Top = 3360
Width = 1215
End
Begin VB.TextBox data_g
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
Height = 270
Left = 2520
MaxLength = 25
TabIndex = 10
Top = 2520
Width = 1215
End
Begin MSComCtl2.DTPicker data_e
Height = 300
Left = 2520
TabIndex = 14
Top = 645
Width = 1695
_ExtentX = 2990
_ExtentY = 529
_Version = 393216
CalendarBackColor= 16777215
Format = 24510464
CurrentDate = 37417
End
Begin MSDataListLib.DataCombo data_d
Bindings = "bsappendform.frx":552D2
Height = 330
Left = 2520
TabIndex = 9
Top = 2070
Width = 1455
_ExtentX = 2566
_ExtentY = 582
_Version = 393216
Appearance = 0
Style = 2
BackColor = 14737632
Text = ""
Object.DataMember = "rs商家表预览"
End
Begin VB.TextBox data_b
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
Height = 270
Left = 2520
MaxLength = 20
TabIndex = 8
Top = 1635
Width = 1215
End
Begin VB.TextBox data_a
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
Height = 270
Left = 2520
MaxLength = 10
TabIndex = 7
Top = 1275
Width = 1215
End
Begin MSComCtl2.DTPicker data_f
Height = 300
Left = 2520
TabIndex = 19
Top = 960
Width = 1695
_ExtentX = 2990
_ExtentY = 529
_Version = 393216
CalendarBackColor= 16777215
Format = 24510464
CurrentDate = 37417
End
Begin MSDataListLib.DataCombo data_h
Bindings = "bsappendform.frx":552E7
Height = 330
Left = 2520
TabIndex = 11
Top = 2880
Width = 1455
_ExtentX = 2566
_ExtentY = 582
_Version = 393216
Appearance = 0
Style = 2
BackColor = 14737632
Text = ""
Object.DataMember = "rs商品表预览"
End
Begin VB.Label Label9
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "商品数量"
ForeColor = &H00000000&
Height = 255
Left = 720
TabIndex = 24
Top = 3690
Width = 1500
End
Begin VB.Label Label8
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "单 价"
ForeColor = &H00000000&
Height = 255
Left = 720
TabIndex = 23
Top = 3405
Width = 1500
End
Begin VB.Label Label7
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "商品名"
ForeColor = &H00000000&
Height = 255
Left = 720
TabIndex = 22
Top = 2970
Width = 1500
End
Begin VB.Label Label6
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "实付钱"
ForeColor = &H00000000&
Height = 255
Left = 720
TabIndex = 21
Top = 2565
Width = 1500
End
Begin VB.Label Label5
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "销售日期"
ForeColor = &H00000000&
Height = 255
Left = 720
TabIndex = 20
Top = 1035
Width = 1500
End
Begin VB.Label appendfrmmove
BackColor = &H00C0C0C0&
BackStyle = 0 'Transparent
Height = 285
Left = 360
TabIndex = 18
Top = 0
Width = 4320
End
Begin VB.Label Label4
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "记录日期"
ForeColor = &H00000000&
Height = 255
Left = 720
TabIndex = 17
Top = 720
Width = 1500
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "厂 商"
ForeColor = &H00000000&
Height = 255
Left = 720
TabIndex = 16
Top = 2160
Width = 1500
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "发票号"
ForeColor = &H00000000&
Height = 255
Left = 720
TabIndex = 15
Top = 1680
Width = 1500
End
Begin VB.Label lb_a
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "单据号"
ForeColor = &H00000000&
Height = 255
Left = 720
TabIndex = 6
Top = 1320
Width = 1500
End
Begin VB.Label append_a
BackStyle = 0 'Transparent
Height = 330
Left = 1440
TabIndex = 5
Top = 4200
Width = 885
End
Begin VB.Label exit_a
BackStyle = 0 'Transparent
Height = 330
Left = 2880
TabIndex = 4
Top = 4200
Width = 885
End
Begin VB.Label append_b
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "填 加"
ForeColor = &H00404040&
Height = 180
Left = 1620
TabIndex = 3
Top = 4275
Width = 540
End
Begin VB.Shape append_c
BorderColor = &H00C0C0C0&
FillColor = &H00C0C0C0&
Height = 330
Left = 1440
Top = 4200
Width = 885
End
Begin VB.Label exit_b
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "返 回"
ForeColor = &H00404040&
Height = 180
Left = 3090
TabIndex = 2
Top = 4275
Width = 495
End
Begin VB.Shape exit_c
BorderColor = &H00C0C0C0&
FillColor = &H00C0C0C0&
Height = 330
Left = 2880
Top = 4200
Width = 885
End
Begin VB.Label formcaption
BackStyle = 0 'Transparent
Caption = "填加数据"
ForeColor = &H00000000&
Height = 165
Left = 2130
TabIndex = 1
Top = 90
Width = 735
End
Begin VB.Label frmcaption2
BackStyle = 0 'Transparent
Caption = "填加数据"
ForeColor = &H00FFFFFF&
Height = 165
Left = 2130
TabIndex = 0
Top = 75
Width = 735
End
End
Attribute VB_Name = "bsappendform"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim fd商家表 As ADODB.Recordset
Dim fd商品表 As ADODB.Recordset
Dim rsTemp As ADODB.Recordset
Sub ClearData()
data_a.Text = ""
data_b.Text = ""
data_g.Text = ""
data_i.Text = ""
data_j.Text = ""
End Sub
Sub AppendRecord()
Dim BS_flag As Integer
Dim BS_Money As Long
On Error GoTo err_exit
BS_flag = 1 '购入，因此是1
BS_Money = Val(data_i.Text) * Val(data_j.Text) '应付款数
If Trim(data_a.Text) = "" Or Trim(data_b.Text) = "" Or Trim(data_d.Text) = "" Or Trim(data_g.Text) = "" Or Trim(data_h.Text) = "" Or Trim(data_i.Text) = "" Or Trim(data_j.Text) = "" Then
vMessageBox GetLStr(1), 2, 0
data_a.SetFocus
Exit Sub
End If
rsTemp.Open "select 单据号 from 购销明细表 where 单据号='" & _
Trim(data_a.Text) & "'", mydata.condata, adOpenStatic, adLockReadOnly
If rsTemp.RecordCount > 0 Then
vMessageBox GetLStr(2) & Trim(rsTemp("单据号")), 1, 0
data_a.SetFocus
Else
mydata.condata.Execute "insert into 购销表 " & _
"(单据号,发票号,商家名称,应付款总额,实付款总额,管理员,购销类别,购销日期,日期) values ('" & _
Trim(data_a.Text) & "','" & _
Trim(data_b.Text) & "','" & _
data_d.Text & "'," & _
CStr(BS_Money) & "," & _
CStr(Val(data_g.Text)) & ",'" & _
Now_User & "'," & _
CStr(BS_flag) & "," & _
"#" & Format(data_f.Value, "YYYY-MM-DD") & "#," & _
"#" & Format(data_e.Value, "YYYY-MM-DD") & "#" & _
")"
mydata.condata.Execute "insert into 购销明细表 " & _
"(单据号,商品号,商品名,单价,商品数量,购销类别,日期) values ('" & _
Trim(data_a.Text) & "','" & _
data_h.BoundText & "','" & _
data_h.Text & "'," & _
CStr(Val(data_i.Text)) & "," & _
CStr(Val(data_j.Text)) & "," & _
CStr(BS_flag) & "," & _
"#" & Format(data_e.Value, "YYYY-MM-DD") & "#" & _
")"
vMessageBox GetLStr(3), 1, 0
ClearData
data_a.SetFocus
End If
rsTemp.Close
Exit Sub
err_exit:
vMessageBox Err.Description, 2, 0
End Sub
Private Sub append_a_Click()
AppendRecord
End Sub
Private Sub appendfrmmove_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0
End Sub
Private Sub data_a_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then SendKeys "{TAB}"
End Sub
Private Sub data_b_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then SendKeys "{TAB}"
End Sub
Private Sub data_c_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then SendKeys "{TAB}"
End Sub
Private Sub data_d_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then SendKeys "{TAB}"
End Sub
Private Sub data_g_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then SendKeys "{TAB}"
End Sub
Private Sub data_h_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then SendKeys "{TAB}"
End Sub
Private Sub data_i_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then SendKeys "{TAB}"
End Sub
Private Sub data_j_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
AppendRecord
End If
End Sub
Private Sub exit_a_Click()
Unload Me
bsreg.Show
ReGird 102
End Sub
Private Sub Form_Load()
CenterForm Me
Set rsTemp = New ADODB.Recordset
Set fd商家表 = New ADODB.Recordset
Set fd商品表 = New ADODB.Recordset
fd商家表.Open "select 商家名称 from 商家表", mydata.condata, adOpenStatic, adLockReadOnly
With data_d
Set .DataSource = fd商家表
.ListField = "商家名称"
.BoundColumn = "商家名称"
End With
fd商品表.Open "select 商品名,商品号 from 商品表", mydata.condata, adOpenStatic, adLockReadOnly
With data_h
Set .DataSource = fd商品表
.ListField = "商品名"
.BoundColumn = "商品号"
End With
SetLForm 13 '语言
End Sub
Private Sub append_a_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
append_c.BorderColor = &H808080
End Sub
Private Sub append_a_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
append_c.BorderColor = &HC0C0C0
End Sub
Private Sub exit_a_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
exit_c.BorderColor = &H808080
End Sub
Private Sub exit_a_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
exit_c.BorderColor = &HC0C0C0
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set rsTemp = Nothing
Set fd商家表 = Nothing
Set fd商品表 = Nothing
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -