📄 frmaccount.frm
字号:
Text = "Text1"
Top = 4170
Visible = 0 'False
Width = 1170
End
Begin VB.CheckBox Check2
Caption = "[7]其它"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Index = 7
Left = 285
TabIndex = 7
Top = 4635
Visible = 0 'False
Width = 1080
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Index = 7
Left = 2190
TabIndex = 9
Text = "Text1"
Top = 4680
Visible = 0 'False
Width = 1170
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "帐号:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Index = 0
Left = 90
TabIndex = 25
Top = 300
Width = 600
End
Begin VB.Label lab_no
BorderStyle = 1 'Fixed Single
Caption = "Label3"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 300
Left = 780
TabIndex = 24
Top = 285
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "总额:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 75
TabIndex = 23
Top = 930
Width = 600
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "余额:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 1815
TabIndex = 22
Top = 900
Width = 600
End
Begin VB.Label lab_total
BorderStyle = 1 'Fixed Single
Caption = "帐 号"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF8080&
Height = 300
Left = 795
TabIndex = 21
Top = 885
Width = 900
End
Begin VB.Label lab_ye
BorderStyle = 1 'Fixed Single
Caption = "帐 号"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF80FF&
Height = 300
Left = 2490
TabIndex = 20
Top = 870
Width = 900
End
End
End
Attribute VB_Name = "frmaccount"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Check2_Click(Index As Integer)
'Text1(Index).Enabled = True
If Check2(Index).Value = 1 Then
Select Case Index
Case 0
If Val(lab_ye) = 0 Then
Me.Check2(0).Value = 0
Exit Sub
End If
frm_fk1.n = 0
frm_fk1.Show 1
Case 1
If Val(lab_ye) = 0 Then
Me.Check2(0).Value = 0
Exit Sub
End If
frm_fk1.n = 1
frm_fk1.Show 1
Case 2
If Val(lab_ye) = 0 Then
Me.Check2(0).Value = 0
Exit Sub
End If
frm_fk1.n = 2
frm_fk1.Show 1
Case 3
If Val(lab_ye) = 0 Then
Me.Check2(0).Value = 0
Exit Sub
End If
frm_fk1.n = 3
frm_fk1.Show 1
End Select
Else
lab_ye.Caption = Val(lab_ye.Caption) + Val(Text1(Index).text)
Text1(Index).text = "0.0"
End If
End Sub
Private Sub Command1_Click(Index As Integer)
Dim i As Integer
Dim TxtSQL As String
Dim msgtext As String
Dim mrc As ADODB.Recordset
Select Case Index
Case 0
If Val(Me.lab_ye.Caption) <> 0 Then
MsgBox "付帐不平，无法结帐！", vbExclamation, "警告"
Exit Sub
End If
frm_find.yesno = True
frm_findreturn.yesno = True
updatebank Me.lab_no
Unload Me
Case 1
For i = 0 To 7
Text1(i).Enabled = False
Text1(i).text = "0.0"
Me.Check2(i).Value = 0
Next i
'Me.lab_total.Caption = Format(total, "0.0")
lab_ye.Caption = Me.lab_total.Caption
Case 2
frm_find.yesno = False
frm_findreturn.yesno = False
Unload Me
End Select
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 50 '2
frm_fk.n = 2
If Check2(2).Value = 0 Then
Check2(2).Value = 1
Else
Check2(2).Value = 0
End If
Case 48 '0
frm_fk.n = 0
If Check2(0).Value = 0 Then
Check2(0).Value = 1
Else
Check2(0).Value = 0
End If
Case 49 '1
frm_fk.n = 1
If Check2(1).Value = 0 Then
Check2(1).Value = 1
Else
Check2(1).Value = 0
End If
Case 51 '3
frm_fk.n = 3
If Check2(3).Value = 0 Then
Check2(3).Value = 1
Else
Check2(3).Value = 0
End If
' Case 52 '4
' frm_fk.n = 4
' Check2(4).SetFocus
' frm_fk.Show 1
' Case 53 '5
' frm_fk.n = 5
' Check2(5).SetFocus
' frm_fk.Show 1
' Case 54 '6
' frm_fk.n = 6
' Check2(6).SetFocus
' frm_fk.Show 1
' Case 55 '7
' frm_fk.n = 7
' Check2(7).SetFocus
' frm_fk.Show 1
End Select
End Sub
Private Sub Form_Load()
Dim i As Integer
Me.Top = 1400
For i = 0 To 7
Text1(i).Enabled = False
Text1(i).text = "0.0"
Next i
End Sub
Private Sub updatebank(sales_id As Integer)
Dim mrc As ADODB.Recordset
Dim TxtSQL As String
Dim msgtext As String
Dim i As Integer
' TxtSQL = "select * from account where account_id<>'' order by account_id"
' Set mrc = ExecuteSQL(TxtSQL, MsgText)
TxtSQL = "select * from sale_bank where sale_id=" & sales_id
Set mrc = ExecuteSQL(TxtSQL, msgtext)
For i = 0 To Me.Check2.Count - 1
If Me.Check2(i).Value = 1 Then
With mrc
.AddNew
!sale_id = sales_id
!discrition = Mid(Me.Check2(i).Caption, 4)
!account_id = Me.Check2(i).Index
!account = Me.Text1(i).text
!account_time = Now
.Update
End With
End If
Next i
If Me.Check2(3).Value = 1 Then
frm_find.zsd = True
Else
frm_find.zsd = False
End If
mrc.Close
' '从库存中除去当前销售数量
'
' TxtSQL = "update Inventory_Sales set onHand= onhand -" & batchtno
' TxtSQL = TxtSQL & " where partid=" & mrc2.Fields(0)
' Set mrc = ExecuteSQL(TxtSQL, MsgText)
'
' '更新表格数量
' With msglist
' .TextMatrix(.Row, 5) = Val(.TextMatrix(.Row, 5)) - batchtno
' End With
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -