合同信息修改.frm

来自「本软件为咨询公司开发的合同管理软件,运用MDB数据库.」· FRM 代码 · 共 718 行 · 第 1/2 页

      TabIndex        =   10
      Top             =   5280
      Width           =   1335
   End
   Begin VB.Label Label10 
      Caption         =   "认证机构："
      Height          =   375
      Left            =   720
      TabIndex        =   9
      Top             =   4788
      Width           =   1335
   End
   Begin VB.Label Label9 
      Caption         =   "发证日期："
      Height          =   375
      Left            =   720
      TabIndex        =   8
      Top             =   4296
      Width           =   1335
   End
   Begin VB.Label Label8 
      Caption         =   "启动日期："
      Height          =   375
      Left            =   720
      TabIndex        =   7
      Top             =   3804
      Width           =   1335
   End
   Begin VB.Label Label1 
      Caption         =   "合同编号："
      Height          =   375
      Left            =   720
      TabIndex        =   6
      Top             =   360
      Width           =   1335
   End
   Begin VB.Label Label2 
      Caption         =   "单位名称："
      Height          =   375
      Left            =   720
      TabIndex        =   5
      Top             =   852
      Width           =   1335
   End
   Begin VB.Label Label3 
      Caption         =   "体    系："
      Height          =   375
      Left            =   720
      TabIndex        =   4
      Top             =   1344
      Width           =   1335
   End
   Begin VB.Label Label4 
      Caption         =   "部门责任人："
      Height          =   375
      Left            =   720
      TabIndex        =   3
      Top             =   1830
      Width           =   1455
   End
   Begin VB.Label Label5 
      Caption         =   "签 约 人："
      Height          =   375
      Left            =   720
      TabIndex        =   2
      Top             =   2328
      Width           =   1335
   End
   Begin VB.Label Label6 
      Caption         =   "咨 询 师："
      Height          =   375
      Left            =   720
      TabIndex        =   1
      Top             =   2820
      Width           =   1335
   End
   Begin VB.Label Label7 
      Caption         =   "签订日期："
      Height          =   375
      Left            =   720
      TabIndex        =   0
      Top             =   3312
      Width           =   1335
   End
End
Attribute VB_Name = "合同信息修改"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim txrs As Recordset
Dim rs As Recordset
Dim txad As ADODB.Connection
Dim jgdb As ADODB.Connection
Dim xxdb As ADODB.Connection
Dim txar As ADODB.Recordset
Dim jgrs As ADODB.Recordset
Dim xxrs As ADODB.Recordset

'Dim lj As String
Dim strsql As String
Private Sub DBCombo3_Change()
 
 Data3.RecordSource = "select * from 合同信息表 where 单位名称 like '*" & Trim(DBCombo3.Text) & "*'"
 Data3.Refresh
 


End Sub

Private Sub DBCombo3_Click(Area As Integer)
DBCombo3.Refresh
DBCombo3.ListField = "单位名称"
DBCombo3.ReFill

End Sub


Private Sub Command1_Click()
Dim sqltr As String
sqltr = ""
If Trim(Text12.Text) <> "" Then
    If sqltr = "" Then
    sqltr = " 编号 = '" & Trim(Text12.Text) & "'"
    Else
    sqltr = sqltr + " AND 编号 = '" & Trim(Text12.Text) & "'"
    End If
End If
If Trim(DBCombo3.Text) <> "" Then
    If sqltr = "" Then
    sqltr = " 单位名称 = '" & Trim(DBCombo3.Text) & "'"
    Else
    sqltr = sqltr + " AND 单位名称 = '" & Trim(DBCombo3.Text) & "'"
    End If
End If
     
If Trim(Text12.Text) = "" And Trim(DBCombo3.Text = "") Then
    MsgBox "你没有输入需要查询的条件", vbOKOnly, "提示信息!"
    GoTo bb
End If
    
    Set xxdb = New ADODB.Connection
    xxdb.CursorLocation = adUseClient
    xxdb.Open "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & dblj & ";Persist Security Info=False"
    Set xxrs = New ADODB.Recordset
    sqltr = "select * from 合同信息表  where " & sqltr
    xxrs.Open sqltr, xxdb, adOpenKeyset, adLockOptimistic
    res = xxrs.RecordCount
    If res = 0 Then
    MsgBox "没有查询到你需要的数据", vbOKOnly, "信息提示!!"
    Text12.Text = ""
    DBCombo1.Text = ""
    Text12.SetFocus
    GoTo bb
    Else
Text1.Text = xxrs!编号
Text2.Text = xxrs!单位名称
DBCombo1.Text = xxrs!体系
Text3.Text = xxrs!部门责任人
Text4.Text = xxrs!签约人
Text5.Text = xxrs!咨询师
Text6.Text = xxrs!签订日期
Text7.Text = xxrs!启动日期
Text8.Text = xxrs!发证日期
DBCombo2.Text = xxrs!认证机构
Text9.Text = xxrs!认证性质
Text10.Text = xxrs!合同金额
Text11.Text = xxrs!认证费
Text14.Text = xxrs!咨询费
Text15.Text = xxrs!备注
End If
Text1.SetFocus
bb:
End Sub

Private Sub Command2_Click()
Text12.Text = ""
DBCombo3.Text = ""

Text1.Text = ""
Text2.Text = ""
DBCombo1.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
DBCombo2.Text = ""
Text9.Text = ""
Text10.Text = ""
Text11.Text = ""
Text14.Text = ""
Text15.Text = ""
Text12.SetFocus
End Sub

Private Sub Command3_Click()

On Error GoTo bb
aa = MsgBox("你要修改该记录吗?", vbYesNo, "信息提示!!")
If aa = 6 Then


xxrs!编号 = Trim(Text1.Text)
xxrs!单位名称 = Trim(Text2.Text)
xxrs!体系 = Trim(DBCombo1.Text)
xxrs!部门责任人 = Trim(Text3.Text)
xxrs!签约人 = Trim(Text4.Text)
xxrs!咨询师 = Trim(Text5.Text)
xxrs!签订日期 = Trim(Text6.Text)
xxrs!启动日期 = Trim(Text7.Text)
xxrs!发证日期 = Trim(Text8.Text)
xxrs!认证机构 = Trim(DBCombo2.Text)
xxrs!认证性质 = Trim(Text9.Text)
xxrs!合同金额 = Trim(Text10.Text)
xxrs!认证费 = Trim(Text11.Text)
xxrs!咨询费 = Trim(Text14.Text)
xxrs!备注 = Trim(Text15.Text)


xxrs.Resync
Text1.SetFocus
Else
Text1.Text = xxrs!编号
Text2.Text = xxrs!单位名称
DBCombo1.Text = xxrs!体系
Text3.Text = xxrs!部门责任人
Text4.Text = xxrs!签约人
Text5.Text = xxrs!咨询师
Text6.Text = xxrs!签订日期
Text7.Text = xxrs!启动日期
Text8.Text = xxrs!发证日期
DBCombo2.Text = xxrs!认证机构
Text9.Text = xxrs!认证性质
Text10.Text = xxrs!合同金额
Text11.Text = xxrs!认证费
Text14.Text = xxrs!咨询费
Text15.Text = xxrs!备注


End If
GoTo cc


bb:
yy = MsgBox(msg, vbOKOnly, "录入的项目不能为空,请检查!!")

cc:

End Sub

Private Sub Command4_Click()
On Error GoTo bb
jgrs.ActiveConnection = Nothing
jgdb.Close
txar.ActiveConnection = Nothing
txad.Close
xxrs.ActiveConnection = Nothing
xxdb.Close
bb:

Data1.Database.Close
Data2.Database.Close

Unload Me
End Sub

Private Sub Command5_Click()
If Text1.Text = "" Then
aa = MsgBox("没有需删除的记录?", vbYesNo, "信息提示!!")
Else
aa = MsgBox("你要删除该记录吗?", vbYesNo, "信息提示!!")
If aa = 6 Then
xxrs.Delete
Text1.Text = ""
Text2.Text = ""
DBCombo1.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
DBCombo2.Text = ""
Text9.Text = ""
Text10.Text = ""
Text11.Text = ""
Text14.Text = ""
Text15.Text = ""
Text12.Text = ""
DBCombo13.Text = ""
Text12.SetFocus
End If
End If
End Sub

Private Sub DBCombo1_Change()
'    On Error GoTo aa
'     Set jgdb = New ADODB.Connection
'     jgdb.CursorLocation = adUseClient
'     jgdb.Open "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & dblj & ";Persist Security Info=False"
'     strsql = "select * from  体系  where 体系 = " & "'" & DBCombo1.Text & "'"    '搜索满足条件的记录
'     Set jgrs = New ADODB.Recordset
'     jgrs.Open strsql, jgdb, adOpenKeyset, adLockOptimistic
'aa:
  Data1.RecordSource = "select * from 体系 where 体系 like '*" & DBCombo1.Text & "*'"
  Data1.Refresh
'  Data1.Recordset.Requery
'  DBCombo1.ListField = "体系"
'  DBCombo1.ReFill
End Sub

Private Sub DBCombo1_Click(Area As Integer)
DBCombo1.Refresh
DBCombo1.ListField = "体系"
DBCombo1.ReFill
End Sub


Private Sub DBCombo2_Change()
'    On Error GoTo aa
'     Set txad = New ADODB.Connection
'     txad.CursorLocation = adUseClient
'     txad.Open "Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & dblj & ";Persist Security Info=False"
'     strsql = "select * from  认证机构 where 认证机构 = " & "'" & DBCombo2.Text & "'"    '搜索满足条件的记录
'     Set txar = New ADODB.Recordset
'     txar.Open strsql, txad, adOpenKeyset, adLockOptimistic
'aa:
  Data2.RecordSource = "select * from 认证机构 where 认证机构 like '*" & DBCombo2.Text & "*'"
  Data2.Refresh
'  Data2.Recordset.Requery
'  DBCombo2.ListField = "认证机构"
'  DBCombo2.ReFill
End Sub

Private Sub DBCombo2_Click(Area As Integer)
DBCombo2.Refresh
DBCombo2.ListField = "认证机构"
DBCombo2.ReFill

End Sub

Private Sub Form_Activate()
Text12.SetFocus
End Sub

Private Sub Form_Load()
'dblj = App.Path + "\data\htxxk.mdb"
Data1.DatabaseName = dblj
Data1.RecordSource = "体系"
Data2.DatabaseName = dblj
Data2.RecordSource = "认证机构"
Data3.DatabaseName = dblj
Data3.RecordSource = "合同信息表"

End Sub