📄 frmeditshangjia.frm
字号:
Left = 240
TabIndex = 29
Top = 2025
Width = 900
End
Begin VB.Label Label8
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "邮政编码："
Height = 180
Left = 240
TabIndex = 28
Top = 2475
Width = 900
End
Begin VB.Label Label9
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "企业电话："
Height = 180
Left = 240
TabIndex = 27
Top = 2865
Width = 900
End
Begin VB.Label Label10
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "企业传真："
Height = 180
Left = 240
TabIndex = 26
Top = 3285
Width = 900
End
Begin VB.Label Label11
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "企业网址："
Height = 180
Left = 240
TabIndex = 25
Top = 3705
Width = 900
End
Begin VB.Label Label12
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "经营范围："
Height = 180
Left = 240
TabIndex = 24
Top = 4500
Width = 900
End
Begin VB.Label Label13
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "法人代表："
Height = 180
Left = 240
TabIndex = 23
Top = 4110
Width = 900
End
Begin VB.Label Label17
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "*"
Height = 180
Left = 6390
TabIndex = 22
Top = 360
Width = 90
End
Begin VB.Label Label18
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "*"
Height = 180
Left = 6375
TabIndex = 21
Top = 765
Width = 90
End
Begin VB.Label Label19
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "*"
Height = 180
Left = 6375
TabIndex = 20
Top = 1185
Width = 90
End
Begin VB.Label Label20
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "*"
Height = 180
Left = 6375
TabIndex = 19
Top = 1605
Width = 90
End
End
Begin CSCommand.Command Command7
Height = 360
Left = 3195
TabIndex = 42
Top = 6960
Width = 1290
_ExtentX = 2275
_ExtentY = 635
IconAlign = 0
Icon = "frmeditshangjia.frx":00A8
Caption = "拜访记录 &B"
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.Label EditId
AutoSize = -1 'True
BackStyle = 0 'Transparent
Height = 180
Left = 735
TabIndex = 38
Top = 6930
Visible = 0 'False
Width = 90
End
End
Attribute VB_Name = "Form3"
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 Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Sub Command1_Click()
If Trim(Text3.Text) = "" Then
MsgBox "企业名称不得为空，请仔细填写各项。", vbInformation, "名称为空"
Exit Sub
End If
If Trim(Text3.Text) = "" Or Trim(Text4.Text) = "" Or Trim(Text5.Text) = "" Or Trim(Text6.Text) = "" Then
MsgBox "输入框后面标上星号的项目为必须填写的东西，请认真填写各项信息，否则无法完成添加操作。", vbInformation, "信息不全"
Exit Sub
End If
If Len(Trim(Text13.Text)) > 700 Then
MsgBox "经营范围文字内容过长，请保持在700字范围之内。", vbInformation, "文字内容过长"
Exit Sub
End If
Dim db As Database
Dim rs As Recordset
Set db = OpenDatabase(MdbPath)
Set rs = db.OpenRecordset("select * from com where id=" & Val(Form3.EditId.Caption))
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.Edit
rs!企业名称 = Trim(Text3.Text)
rs!企业助记码 = Trim(Text4.Text)
rs!企业性质 = Trim(Text5.Text)
rs!企业行业 = Trim(Text6.Text)
rs!企业地址 = Trim(Text7.Text)
rs!邮政编码 = Trim(Text8.Text)
rs!企业电话 = Trim(Text12.Text)
rs!企业传真 = Trim(Text11.Text)
rs!企业网址 = Trim(Text10.Text)
rs!经营范围 = Trim(Text13.Text)
rs!法人代表 = Trim(Text9.Text)
rs.Update
MsgBox "商家资料修改成功！", vbInformation, "修改完毕"
Me.Hide
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
If form2show = True Then
Form2.SetFocus
allshow (Form2.Label1.Caption)
Unload Me
Else
Unload Me
End If
End If
End Sub
Private Sub Command2_Click()
If Text9.Text = "" Then Exit Sub
Dim db As Database
Set db = OpenDatabase(MdbPath)
Dim rs As Recordset
Set rs = db.OpenRecordset("select * from ren where 姓名='" & Text9.Text & "'")
If rs.RecordCount = 1 Then
If form5show = True Then
Form5.SetFocus
Else
Load Form5
Form5.Show
End If
Form5.Label13.Caption = rs!id
Form5.Text1.Text = rs!姓名
Form5.Text2.Text = rs!助记码
Form5.Text3.Text = rs!手机号码
Form5.Text4.Text = rs!小灵通
Form5.Text5.Text = rs!电子信箱
Form5.Text6.Text = rs!QQ号码
Form5.Text7.Text = rs!所属企业
Dim qiyeid As Integer
qiyeid = Val(rs!所属企业)
Form5.Text8.Text = rs!部门
Form5.Text9.Text = rs!职务
Form5.Text10.Text = rs!办公电话
Form5.Text11.Text = rs!办公传真
Form5.Text12.Text = rs!其他说明
rs.Close
Set rs = db.OpenRecordset("select * from com where id =" & qiyeid)
If rs.RecordCount = 0 Then
Form5.Text13.Text = "（取得企业名称失败，传递错误的ID号）"
ElseIf rs.RecordCount = 1 Then
Form5.Text13.Text = rs!企业名称
ElseIf rs.RecordCount > 1 Then
'msgbox "根据传递的企业ID号，软件在数据库里找到了 " & rs.RecordCount & " 个相应的企业，而实际正确的应该只能找到一个。",vbInformation,"定位错误"
Form5.Text13.Text = "（错误：对应的企业不唯一）"
End If
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
ElseIf rs.RecordCount > 1 Then
MsgBox "找到了多个相同的人名，有可能不是正确的，请在联系人列表中重新查找。"
End If
End Sub
Private Sub Command3_Click()
If Val(Form3.EditId.Caption) <> 0 Then
ShowComRen Val(Form3.EditId.Caption)
Unload Me
End If
End Sub
Private Sub Command4_Click()
If Len(Trim(Text10.Text)) > 5 Then
Dim r As Long
r = ShellExecute(0, vbNullString, Trim(Text10.Text), vbNullString, vbNullString, vbNormalFocus)
End If
End Sub
Private Sub Command5_Click()
Load Form18
Form18.Show
Form18.Text5.Text = "修改"
End Sub
Private Sub Command6_Click()
Load FrmHangye
FrmHangye.Show
FrmHangye.Text5.Text = "修改"
End Sub
Private Sub Command7_Click()
If Val(Text2.Text) = 0 Then
MsgBox "定位所属商家的ID号的时候错误：传递到该窗体上的企业ID号码错误，取值失败！", vbInformation, "参数传递失败"
Exit Sub
End If
ShowComBaifang Val(Text2.Text)
End Sub
Private Sub Form_Activate()
ShowForm4
End Sub
Private Sub Form_Load()
form3show = True
ShowForm4
Me.BackColor = FormBackColor
Me.Frame1.BackColor = Me.BackColor
Me.Frame2.BackColor = Me.BackColor
Me.Top = (Screen.Height - Me.Height) / 4
Me.Left = (Screen.Width - Me.Width) / 2
Me.Icon = MDIForm1.Icon
End Sub
Private Sub Form_Unload(Cancel As Integer)
form3show = False
End Sub
Private Sub Text10_GotFocus()
SendKeys "{end}"
End Sub
Private Sub Text11_GotFocus()
SendKeys "{end}"
End Sub
Private Sub Text12_GotFocus()
SendKeys "{end}"
End Sub
Private Sub Text13_GotFocus()
SendKeys "{end}"
End Sub
Private Sub Text3_Change()
Text4.Text = UCase(AutoPY1.AutoPY(Trim(Text3.Text)))
End Sub
Private Sub Text3_GotFocus()
SendKeys "{end}"
End Sub
Private Sub Text4_GotFocus()
SendKeys "{end}"
End Sub
Private Sub Text4_LostFocus()
Text4.Text = Trim(UCase(Text4.Text))
End Sub
Private Sub Text5_GotFocus()
SendKeys "{end}"
End Sub
Private Sub Text6_GotFocus()
SendKeys "{end}"
End Sub
Private Sub Text7_GotFocus()
SendKeys "{end}"
End Sub
Private Sub Text8_GotFocus()
SendKeys "{end}"
End Sub
Private Sub Text9_GotFocus()
SendKeys "{end}"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -