📄 添加拜访记录.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{E95A2510-F3D1-416D-823B-4F840FE98091}#3.0#0"; "Command.ocx"
Begin VB.Form FrmBaiFangAdd
Caption = "添加拜访记录"
ClientHeight = 4935
ClientLeft = 4275
ClientTop = 2325
ClientWidth = 7020
LinkTopic = "Form7"
LockControls = -1 'True
MaxButton = 0 'False
MDIChild = -1 'True
ScaleHeight = 4935
ScaleWidth = 7020
Begin CSCommand.Command Command1
Height = 405
Left = 4650
TabIndex = 14
Top = 4305
Width = 2220
_ExtentX = 3916
_ExtentY = 714
IconAlign = 0
Icon = "添加拜访记录.frx":0000
Caption = "保存拜访记录 &S"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin CSCommand.Command Command2
Height = 405
Left = 120
TabIndex = 13
Top = 4290
Width = 2340
_ExtentX = 4128
_ExtentY = 714
IconAlign = 0
Icon = "添加拜访记录.frx":001C
Caption = "本商家的拜访记录 &L"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Frame Frame2
Caption = "添加拜访内容"
Height = 3285
Left = 90
TabIndex = 8
Top = 900
Width = 6810
Begin VB.TextBox Text2
Height = 2040
Left = 1695
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 4
Text = "添加拜访记录.frx":0038
Top = 1080
Width = 4980
End
Begin VB.ComboBox Combo2
Height = 300
Left = 1695
TabIndex = 3
Text = "Combo2"
Top = 690
Width = 2250
End
Begin VB.ComboBox Combo1
Height = 300
Left = 4710
TabIndex = 2
Top = 270
Width = 1980
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 300
Left = 1695
TabIndex = 1
Top = 270
Width = 2235
_ExtentX = 3942
_ExtentY = 529
_Version = 393216
Format = 55967745
CurrentDate = 39024
End
Begin VB.Label Label6
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "拜访内容和结果："
Height = 180
Left = 225
TabIndex = 12
Top = 1110
Width = 1440
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "拜访人："
Height = 180
Left = 945
TabIndex = 11
Top = 750
Width = 720
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "受访人："
Height = 180
Left = 4005
TabIndex = 10
Top = 330
Width = 720
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "本次拜访的时间："
Height = 180
Left = 225
TabIndex = 9
Top = 360
Width = 1440
End
End
Begin VB.Frame Frame1
Caption = "指定商家"
Height = 735
Left = 90
TabIndex = 5
Top = 90
Width = 6810
Begin VB.TextBox Text1
Enabled = 0 'False
Height = 315
Left = 1695
TabIndex = 0
Top = 255
Width = 4980
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "本次拜访的商家："
Height = 180
Left = 255
TabIndex = 6
Top = 330
Width = 1440
End
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Height = 240
Left = 3120
TabIndex = 7
Top = 4500
Visible = 0 'False
Width = 1125
End
End
Attribute VB_Name = "FrmBaiFangAdd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/12/24
'描 述：商务名片及客户资料管理系统 Ver 1.73
'网 站：http://www.Mndsoft.com/ (VB6源码博客)
'网 站：http://www.VbDnet.com/ (VB.NET源码博客,主要基于.NET2005)
'e-mail ：Mndsoft@163.com
'e-mail ：Mndsoft@126.com
'OICQ ：88382850
' 如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Option Explicit
Private Sub Command1_Click()
If Len(Trim(Text2.Text)) > 700 Then
MsgBox "拜访记录摘要文字内容过长，请保持在700字范围之内。", vbInformation, "文字内容过长"
Text2.SetFocus
Exit Sub
End If
If Val(Me.Label2.Caption) = 0 Then
MsgBox "没有取得商家的ID号，无法保存拜访记录。", vbInformation, "商家的ID号丢失"
Exit Sub
End If
If Trim(Combo1.Text) = "" Then
Combo1.SetFocus
Exit Sub
End If
If Trim(Combo2.Text) = "" Then
Combo2.SetFocus
Exit Sub
End If
If Trim(Me.Text2.Text) = "" Then
Text2.SetFocus
Exit Sub
End If
Dim db As Database
Dim rs As Recordset
Set db = OpenDatabase(MdbPath)
Set rs = db.OpenRecordset("select * from baifang")
rs.AddNew
rs!企业ID号 = Val(Me.Label2.Caption)
rs!拜访时间 = Me.DTPicker1.Value
rs!受访人 = Me.Combo1.Text
rs!拜访人 = Me.Combo2.Text
rs!内容 = Me.Text2.Text
rs.Update
MsgBox "添加摆放记录的操作已执行完毕。", vbInformation, "添加完毕"
SumNumber
If AllBaiFangShow = True Then
'If AllBaiFang.MSFlexGrid1.Rows > 500 Then
' MsgBox "因表格中数据量较大，软件不再提供自动刷新的功能，请需要的时候手动刷新以便查看添加结果。", vbInformation, "请手动刷新"
'Else
If Trim(AllBaiFang.Label3.Caption) <> "" Then
ShowAllBaiFang (AllBaiFang.Label3.Caption)
End If
'End If
End If
Unload Me
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
End Sub
Private Sub Command2_Click()
If form13show = True Then
Form13.SetFocus
Else
Load Form13
Form13.Show
End If
Form13.Frame3.Visible = True
Form13.Label5.Caption = "正在准备读取数据库 ... "
If Val(Label2.Caption) = 0 Then
MsgBox "定位所属商家的ID号的时候错误：传递到该窗体上的企业ID号码错误，取值失败！", vbInformation, "参数传递失败"
Exit Sub
End If
Form13.Label5.Caption = "正在打开数据库 ... "
Dim db As Database
Dim rs As Recordset
Set db = OpenDatabase(MdbPath)
Set rs = db.OpenRecordset("select * from baifang where 企业ID号 =" & Trim(Label2.Caption) & " order by id desc")
If rs.RecordCount > 0 Then '''''''''''''''''''''''''''''''''''这段代码为循环显示拜访记录到列表中。''''''''''''''''''
Dim i As Integer
Form13.Label5.Caption = "数据库已经打开，正在读取数据 ... "
Form13.MSFlexGrid1.Cols = 5
Form13.Text7.Text = Val(Trim(Label2.Caption))
rs.MoveLast
rs.MoveFirst
Form13.MSFlexGrid1.Rows = rs.RecordCount + 1
Form13.MSFlexGrid1.ColWidth(0) = 500
Form13.MSFlexGrid1.ColWidth(1) = 1000
Form13.MSFlexGrid1.ColWidth(2) = 1200
Form13.MSFlexGrid1.ColWidth(3) = 1200
Form13.MSFlexGrid1.ColWidth(4) = 7800
Form13.MSFlexGrid1.TextMatrix(0, 0) = "ID"
Form13.MSFlexGrid1.TextMatrix(0, 1) = "拜访时间"
Form13.MSFlexGrid1.TextMatrix(0, 2) = "受访人"
Form13.MSFlexGrid1.TextMatrix(0, 3) = "拜访人"
Form13.MSFlexGrid1.TextMatrix(0, 4) = "内容"
For i = 1 To rs.RecordCount
Form13.Label5.Caption = "正在加载数据，请稍候 ... " & i & " " & "/" & rs.RecordCount
Form13.MSFlexGrid1.TextMatrix(i, 0) = rs!id
Form13.MSFlexGrid1.TextMatrix(i, 1) = rs!拜访时间
Form13.MSFlexGrid1.TextMatrix(i, 2) = rs!受访人
Form13.MSFlexGrid1.TextMatrix(i, 3) = rs!拜访人
Form13.MSFlexGrid1.TextMatrix(i, 4) = rs!内容
If rs.EOF Then
Exit For
Else
rs.MoveNext
End If
DoEvents
Next i
Form13.Label5.Caption = "数据库读取完毕。"
End If
Form13.Label5.Caption = "正在关闭数据库 ... "
rs.Close
Set rs = db.OpenRecordset("select * from com where ID =" & Trim(Label2.Caption) & " order by id desc")
If rs.RecordCount = 0 Then
MsgBox "数据出现了致命的错误，可能数据库已经紊乱，请立即和软件作者联系。软件在读取商家的信息的时候出现了错误：返回的商家集合为空！", vbInformation, "数据处理错误"
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
Exit Sub
ElseIf rs.RecordCount = 1 Then
rs.MoveLast
If rs.RecordCount = 1 Then
Form13.Text1.Text = rs!企业名称
Form13.Text2.Text = rs!企业电话
Form13.Text3.Text = rs!企业地址
If Trim(rs!邮政编码) <> "" Then
Form13.Text3.Text = rs!企业地址 & " （" & rs!邮政编码 & " ）"
End If
Form13.Text4.Text = rs!法人代表
End If
ElseIf rs.RecordCount > 1 Then
MsgBox "数据出现了致命的错误，可能数据库已经紊乱，请立即和软件作者联系。软件在读取商家的信息的时候出现了错误：返回的商家集合有多个商家！", vbInformation, "数据处理错误"
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
Exit Sub
End If
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
Form13.Label5.Caption = "数据库加载完毕。"
Form13.Frame3.Width = Form13.Label5.Width + 250
End Sub
Private Sub Form_Load()
Me.Icon = MDIForm1.Icon
Me.BackColor = FormBackColor: Me.Frame1.BackColor = Me.BackColor
Me.Frame2.BackColor = Me.BackColor
Me.Height = 5340
Me.Width = 7140
Dim db As Database
Dim rs As Recordset
Set db = OpenDatabase(MdbPath)
Set rs = db.OpenRecordset("select * from ren where 所属企业=" & Val(Me.Label2.Caption))
'FrmBaiFangAdd.DTPicker1.CustomFormat = ("yyyy-MM-dd")
Me.DTPicker1.Value = Date
'MsgBox rs.RecordCount
Me.Text2.Text = ""
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
End Sub
Private Sub Form_Resize()
On Error GoTo reerror
Me.Height = 5340
Me.Width = 7140
reerror:
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -