📄 frm_model.frm
字号:
Index = 16
Left = 3360
TabIndex = 47
Top = 1680
Width = 270
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "16."
Height = 180
Index = 15
Left = 3360
TabIndex = 46
Top = 1440
Width = 270
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "15."
Height = 180
Index = 14
Left = 3360
TabIndex = 45
Top = 1200
Width = 270
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "14."
Height = 180
Index = 13
Left = 3360
TabIndex = 44
Top = 960
Width = 270
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "13."
Height = 180
Index = 12
Left = 3360
TabIndex = 43
Top = 720
Width = 270
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "12."
Height = 180
Index = 11
Left = 3360
TabIndex = 42
Top = 480
Width = 270
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "11."
Height = 180
Index = 10
Left = 3360
TabIndex = 41
Top = 240
Width = 270
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "10."
Height = 180
Index = 9
Left = 120
TabIndex = 40
Top = 2400
Width = 270
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "9."
Height = 180
Index = 8
Left = 120
TabIndex = 39
Top = 2160
Width = 180
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "8."
Height = 180
Index = 7
Left = 120
TabIndex = 38
Top = 1920
Width = 180
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "7."
Height = 180
Index = 6
Left = 120
TabIndex = 37
Top = 1680
Width = 180
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "6."
Height = 180
Index = 5
Left = 120
TabIndex = 36
Top = 1440
Width = 180
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "5."
Height = 180
Index = 4
Left = 120
TabIndex = 35
Top = 1200
Width = 180
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "4."
Height = 180
Index = 3
Left = 120
TabIndex = 34
Top = 960
Width = 180
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "3."
Height = 180
Index = 2
Left = 120
TabIndex = 33
Top = 720
Width = 180
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "2."
Height = 180
Index = 1
Left = 120
TabIndex = 32
Top = 480
Width = 180
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "1."
Height = 180
Index = 0
Left = 100
TabIndex = 31
Top = 277
Width = 180
End
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "客户姓名："
Height = 180
Left = 6960
TabIndex = 25
Top = 120
Width = 900
End
End
Attribute VB_Name = "UfrmKeHuXuQo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Me.MousePointer = 11
Dim fbwt_DataT(19) As Integer
Dim Fbwt_Rs As Recordset
Dim fbwt_Str As String
fbwt_Str = "无内容"
Dim i As Integer
Dim fbwt_RsOne As Recordset
Set fbwt_RsOne = New Recordset
Set Fbwt_Rs = New Recordset
Dim Cn As New Connection
Call ConnectDataBase
Cn.Open cnDataBase_GivePower
Cn.CursorLocation = adUseClient
'fbwt_Rs.Fields("具体项目").Value = "无内容"
fbwt_RsOne.Open "select * from kehus where 具体项目<>'" & fbwt_Str & "'", Cn, adOpenStatic
fbwt_Str = "1"
For i = 0 To fbwt_RsOne.RecordCount - 1
Fbwt_Rs.Open "select * from kehu where a" & i & " ='" & fbwt_Str & "'", Cn, adOpenStati
fbwt_DataT(i) = Fbwt_Rs.RecordCount
Fbwt_Rs.Close
Next
MSChart1.ColumnCount = 1
MSChart1.RowCount = fbwt_RsOne.RecordCount
For i = 0 To fbwt_RsOne.RecordCount - 1
MSChart1.Row = i + 1
MSChart1.RowLabel = i + 1
MSChart1.Column = 1
MSChart1.Data = fbwt_DataT(i)
Next
MSChart1.ColumnLabel = "客户需求量"
Me.MousePointer = 0
End Sub
Private Sub Command2_Click()
'On Error Resume Next
Me.MousePointer = 11
If Text1.Text = "" Then
MsgBox ("请输入客户姓名！"), vbExclamation
Me.MousePointer = 0
Exit Sub
End If
Dim Cn As New Connection
Dim Fbwt_Rs As New Recordset
Call ConnectDataBase
Cn.Open cnDataBase_GivePower
Cn.CursorLocation = adUseClient
Fbwt_Rs.Open "select * from kehu where kehuo='" & Text1.Text & "'", Cn, adOpenStatic
If Fbwt_Rs.BOF And Fbwt_Rs.EOF Then
MsgBox ("没有这个客户！"), vbExclamation
Me.MousePointer = 0
Exit Sub
Else
For i = 0 To 19
Check1(i).Value = Fbwt_Rs.Fields("a" & i & "").Value
Next
End If
Me.MousePointer = 0
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Command4_Click()
MSChart1.chartType = VtChChartType2dBar
End Sub
Private Sub Command5_Click()
'On Error Resume Next
Me.MousePointer = 11
If Text1.Text = "" Then
MsgBox ("请输入客户姓名！"), vbExclamation
Me.MousePointer = 0
Exit Sub
End If
Dim Cn As New Connection
Dim Fbwt_Rs As New Recordset
Call ConnectDataBase
Cn.Open cnDataBase_GivePower
Cn.CursorLocation = adUseClient
Fbwt_Rs.Open "select * from kehu where kehuo='" & Text1.Text & "'", Cn, adOpenStatic
If Fbwt_Rs.BOF And Fbwt_Rs.EOF Then
Cn.Execute "insert into kehu(kehuo) values('" & Text1.Text & "')"
End If
For i = 0 To 19
Cn.Execute "update kehu set a" & i & "='" & Check1(i).Value & "' where kehuo='" & Text1.Text & "'"
Next
MsgBox ("成功！"), vbInformation
Me.MousePointer = 0
End Sub
Private Sub Command6_Click()
MSChart1.chartType = VtChChartType2dLine
End Sub
Private Sub Form_Load()
'On Error Resume Next
Me.MousePointer = 11
Dim Cn As New Connection
Dim Fbwt_Rs As New Recordset
Call ConnectDataBase
Cn.Open cnDataBase_GivePower
Cn.CursorLocation = adUseClient
Fbwt_Rs.Open "select * from kehus", Cn, adOpenStatic
For i = 0 To Fbwt_Rs.RecordCount - 1
If Fbwt_Rs.Fields("具体项目").Value = "无内容" Then
Label2(Fbwt_Rs.Fields("编号").Value).Enabled = False
Check1(Fbwt_Rs.Fields("编号").Value).Caption = Fbwt_Rs.Fields("具体项目").Value
Check1(Fbwt_Rs.Fields("编号").Value).Enabled = False
Else
Check1(Fbwt_Rs.Fields("编号").Value).Caption = Fbwt_Rs.Fields("具体项目").Value
End If
Fbwt_Rs.MoveNext
Next
Me.MousePointer = 0
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -