📄 frmpublishingcompanydata.frm
字号:
VERSION 5.00
Begin VB.Form FrmPublishingCompanyData
Appearance = 0 'Flat
BackColor = &H00C0E0FF&
BorderStyle = 3 'Fixed Dialog
Caption = "出版社资料管理"
ClientHeight = 4785
ClientLeft = 45
ClientTop = 330
ClientWidth = 4515
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4785
ScaleWidth = 4515
ShowInTaskbar = 0 'False
Begin VB.CommandButton cmdSave
Appearance = 0 'Flat
Height = 435
Left = 1080
Picture = "FrmPublishingCompanyData.frx":0000
Style = 1 'Graphical
TabIndex = 8
Top = 4215
Width = 930
End
Begin VB.CommandButton cmdExit
Appearance = 0 'Flat
Height = 435
Left = 2205
Picture = "FrmPublishingCompanyData.frx":14E4
Style = 1 'Graphical
TabIndex = 9
Top = 4215
Width = 960
End
Begin VB.TextBox txtFields
Appearance = 0 'Flat
Height = 1020
Index = 7
Left = 675
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 7
Top = 3060
Width = 3735
End
Begin VB.TextBox txtFields
Appearance = 0 'Flat
Height = 375
Index = 4
Left = 675
TabIndex = 4
Top = 1755
Width = 2295
End
Begin VB.TextBox txtFields
Appearance = 0 'Flat
Height = 375
Index = 3
Left = 675
TabIndex = 3
Top = 1335
Width = 3735
End
Begin VB.TextBox txtFields
Appearance = 0 'Flat
Height = 375
Index = 2
Left = 675
TabIndex = 2
Top = 915
Width = 3750
End
Begin VB.TextBox txtFields
Appearance = 0 'Flat
Height = 375
Index = 1
Left = 675
TabIndex = 1
Top = 480
Width = 2280
End
Begin VB.TextBox txtFields
Appearance = 0 'Flat
Enabled = 0 'False
Height = 375
Index = 0
Left = 675
TabIndex = 0
Top = 60
Width = 2295
End
Begin VB.TextBox txtFields
Appearance = 0 'Flat
Height = 375
Index = 5
Left = 675
TabIndex = 5
Top = 2175
Width = 2295
End
Begin VB.TextBox txtFields
Appearance = 0 'Flat
Height = 375
Index = 6
Left = 675
TabIndex = 6
Top = 2595
Width = 2295
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "备注"
Height = 255
Index = 7
Left = -165
TabIndex = 17
Top = 3480
Width = 975
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "邮编"
Height = 255
Index = 6
Left = -165
TabIndex = 16
Top = 2715
Width = 975
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "联系人"
Height = 255
Index = 5
Left = -165
TabIndex = 15
Top = 2280
Width = 975
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "电话"
Height = 255
Index = 4
Left = -165
TabIndex = 14
Top = 1905
Width = 975
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "地址"
Height = 255
Index = 3
Left = -165
TabIndex = 13
Top = 1500
Width = 975
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "全称"
Height = 255
Index = 2
Left = -165
TabIndex = 12
Top = 1080
Width = 975
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "社名"
Height = 255
Index = 1
Left = -165
TabIndex = 11
Top = 630
Width = 975
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "社号"
Height = 255
Index = 0
Left = -165
TabIndex = 10
Top = 180
Width = 975
End
End
Attribute VB_Name = "FrmPublishingCompanyData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public strPrimaryKey As String
Public blnAddNew As Boolean
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub CmdSave_Click()
Dim sqlstring As String
Dim rstmp As New ADODB.Recordset
On Error GoTo SaveErr
If blnAddNew Then
If Trim(txtFields(0).Text) = "" Or Trim(txtFields(1).Text) = "" Then
MsgBox "编码、名称不能为空！", vbInformation
Exit Sub
End If
If CheckExist Then
MsgBox "此出版社编码已存在，请修改。", vbInformation + vbOKOnly
Call setselect(txtFields(0))
Exit Sub
End If
sqlstring = "Insert into PublishingCompanyData (chrCompanyNo,chrCompanyName,ChrBenelux,ChrAddress,ChrPhoneCode," & _
"ChrLinkman,ChrYouBian,ChrRemark) values ('" & txtFields(0).Text & "','" & txtFields(1).Text & _
"','" & txtFields(2).Text & "','" & txtFields(3).Text & "','" & txtFields(4).Text & "','" & _
txtFields(5).Text & "','" & txtFields(6).Text & "','" & txtFields(7).Text & "')"
cN.BeginTrans
cN.Execute (sqlstring)
cN.CommitTrans
Unload Me
Call frmFields.cmdRefresh_Click
Else
If Trim(txtFields(0).Text) = "" Or Trim(txtFields(1).Text) = "" Then
MsgBox "编码、名称不能为空！", vbInformation
Exit Sub
End If
sqlstring = "Update PublishingCompanyData set chrCompanyName='" & txtFields(1).Text & "'," & _
" ChrBenelux='" & txtFields(2).Text & "',chrAddress='" & txtFields(3).Text & _
"',chrPhoneCode='" & txtFields(4).Text & "',chrLinkMan='" & txtFields(5).Text & _
"',chrYouBian='" & txtFields(6).Text & "',chrRemark='" & txtFields(7).Text & _
"' where chrCompanyNo='" & Trim(txtFields(0).Text) & "'"
cN.BeginTrans
cN.Execute (sqlstring)
cN.CommitTrans
Unload Me
Call frmFields.ShowRecorder("PublishingCompanyData", "chrCompanyNo", "出版社号|出版社|全称|地址|电话|联系人|邮编|备注")
' Call frmFields.cmdRefresh_Click
End If
Exit Sub
SaveErr:
cN.RollbackTrans
MsgBox "保存记录失败：" & err.Description, vbInformation
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
' Call autoreturn(KeyCode)
If KeyCode = vbKeyReturn Then
SendKeys "{TAB}"
Exit Sub
End If
End Sub
Private Function CheckExist() As Boolean
Dim sqlstring As String
Dim rstmp As New ADODB.Recordset
On Error GoTo err
sqlstring = "select * from PublishingCompanyData where chrCompanyNo='" & Trim(txtFields(0).Text) & "'"
rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
If rstmp.EOF Then
CheckExist = False
Else
CheckExist = True
End If
Exit Function
err:
MsgBox "打开记录失败：" & err.Description, vbInformation
End Function
Private Sub txtFields_KeyPress(Index As Integer, KeyAscii As Integer)
Select Case Index
Case 0
KeyAscii = ValiText(KeyAscii, vbExpInteger, "", txtFields(Index).Text, 4)
Case 4
KeyAscii = ValiText(KeyAscii, vbExpInteger, "-", txtFields(Index).Text)
Case 6
KeyAscii = ValiText(KeyAscii, vbExpInteger, "", txtFields(Index).Text)
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -