frmbmb.frm

来自「企业工资管理系统的具体实现」· FRM 代码 · 共 733 行 · 第 1/2 页

               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         BeginProperty Column03 
            DataField       =   "csrq"
            Caption         =   "出生日期"
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         BeginProperty Column04 
            DataField       =   "zz"
            Caption         =   "住址"
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         BeginProperty Column05 
            DataField       =   "sfzh"
            Caption         =   "身份证号"
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         SplitCount      =   1
         BeginProperty Split0 
            ScrollBars      =   3
            BeginProperty Column00 
            EndProperty
            BeginProperty Column01 
            EndProperty
            BeginProperty Column02 
            EndProperty
            BeginProperty Column03 
            EndProperty
            BeginProperty Column04 
               ColumnWidth     =   2520
            EndProperty
            BeginProperty Column05 
               ColumnWidth     =   1995.024
            EndProperty
         EndProperty
      End
   End
End
Attribute VB_Name = "frmbmb"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Dim cnn1 As New ADODB.Recordset
'Dim cnn As New ADODB.Recordset

Private Sub Check1_Click()
If Check1.Value = 1 Then
    Text6.Enabled = True
ElseIf Check1.Value = 0 Then
    Text6.Enabled = False
End If
End Sub

Private Sub Check2_Click()
If Check2.Value = 1 Then
    Text7.Enabled = True
ElseIf Check2.Value = 0 Then
    Text7.Enabled = False
End If
End Sub

Private Sub cmddelete_Click()
Dim cnn As New ADODB.Connection
Dim cnn1 As New ADODB.Recordset
Dim cnn2 As New ADODB.Connection
Dim sql As String, sql1 As String
sql = "delete from bmb"
sql1 = "select * from bmb"
sql2 = "delete from bmb1"
    If Check1.Value = 0 And Check2.Value = 0 Then
        If MsgBox("你确信要删除所有的记录吗，请选择“是”或“否”。", vbInformation + vbYesNo, "提示") = vbNo Then
        Exit Sub
        End If
    ElseIf Check1.Value = 1 Then
        sql = sql & " where xm='" & Trim(Text6.Text) & "'"
        sql1 = sql1 & " where xm='" & Trim(Text6.Text) & "'"
        sql2 = sql2 & " where xm='" & Trim(Text6.Text) & "'"
        Check1.Value = 0
        Text6.Enabled = False
    ElseIf Check2.Value = 1 Then
        sql = sql & " where sfzh='" & Trim(Text7.Text) & "'"
        sql1 = sql1 & " where sfzh='" & Trim(Text7.Text) & "'"
        sql2 = sql2 & " where sfzh='" & Trim(Text7.Text) & "'"
        Check2.Value = 0
        Text7.Enabled = False
    Else
        sql = sql & " where xm='" & Trim(Text6.Text) & "' and sfzh='" & Trim(Text7.Text) & "'"
        sql1 = sql1 & " where xm='" & Trim(Text6.Text) & "' and sfzh='" & Trim(Text7.Text) & "'"
        sql2 = sql2 & " where xm='" & Trim(Text6.Text) & "' and sfzh='" & Trim(Text7.Text) & "'"
        Check1.Value = 0
        Check2.Value = 0
        Text6.Enabled = False
        Text7.Enabled = False
    End If
    With cnn1
        .ActiveConnection = constr
        .CursorLocation = adUseClient
        .CursorType = adOpenDynamic
        .LockType = adLockPessimistic
        .Open sql1
        If .EOF And .BOF Then
            MsgBox "没有要删除的记录，请检查是否有此工人。", vbInformation, "提示"
            Exit Sub
        End If
        .Close
    End With
    Set cnn1 = Nothing
    With cnn                    '在报名表中删除符合条件的记录
        .Open constr
        .Execute sql
        .Close
    End With
    Set cnn = Nothing
    With cnn2               '在报名表附表中删除符合条件的记录
        .Open constr
        .Execute sql2
        .Close
    End With
    Set cnn2 = Nothing
    With Adobmb
        .ConnectionString = constr
        .RecordSource = "select * from bmb"
        .Refresh
    End With
    MsgBox "删除成功！", vbInformation, "提示"
End Sub

Private Sub cmdexit_Click()
Unload Me
End Sub

Private Sub cmdmodify_Click()
Dim cnn As New ADODB.Connection
Dim sql As String, sql1 As String
sql = "select * from bmb"
    If Check1.Value = 1 And Check2.Value = 1 Then               '判断是否按选择条件进行修改
        sql1 = " where xm='" & Trim(Text6.Text) & "' and sfzh='" & Trim(Text7.Text) & "'"
        sql = sql & sql1
        Check1.Value = 0
        Check2.Value = 0
        Text6.Enabled = False
        Text7.Enabled = False
    ElseIf Check1.Value = 1 Then
        sql1 = " where xm='" & Trim(Text6.Text) & "'"
        sql = sql & sql1
        Check1.Value = 0
        Text6.Enabled = False
    ElseIf Check2.Value = 1 Then
        sql1 = " where sfzh='" & Trim(Text7.Text) & "'"
        sql = sql & sql1
        Check2.Value = 0
        Text7.Enabled = False
    End If
If cmdmodify.Caption = "修  改" Then
    With Adobmb
        .ConnectionString = constr
        .RecordSource = sql
        .Refresh
        If Not (.Recordset.EOF And .Recordset.BOF) Then
            cmdmodify.Caption = "确  定"
            cmddelete.Enabled = False
            cmdexit.Enabled = False
            cmdok.Enabled = False
            Check1.Enabled = False
            Check2.Enabled = False
            DataGrid1.AllowUpdate = True
        Else
            MsgBox "没有查到你要修改的记录，请重试！", vbInformation, "提示"
            Exit Sub
        End If
    .Recordset.Update
    End With
Else
'    DataGrid1.ro     '更新电子表格
'    With Adobmb
'        .ConnectionString = constr
'        .RecordSource = sql
'        .Refresh
'    End With
'    Set DataGrid1.DataSource = Adobmb
'    With cnn
'        .Open constr
'        .Execute "delete from bmb1" & sql1          '先删除报名表附表的所有记录
'        .Execute "insert into bmb1 " & sql          '再拷入报名表更新后的记录到报名表附表
'        .Close
'    End With
'    Set cnn = Nothing
    MsgBox "修改成功！", vbInformation, "提示"
    cmdmodify.Caption = "修  改"
    Call cmddel
    cmdexit.Enabled = True
    cmdok.Enabled = True
    Check1.Enabled = True
    Check2.Enabled = True
    DataGrid1.AllowUpdate = False
End If
End Sub

Private Sub cmdok_Click()
Dim cnn As New ADODB.Connection
On Error GoTo err1
If Text1.Text = "" Then
    MsgBox "姓名一栏不能为空。", vbInformation, "提示"
    Exit Sub
End If
With Adobmb
    .ConnectionString = constr
    .RecordSource = "select * from bmb"
    .Refresh
    .Recordset.AddNew
    If Text2.Text <> "" Then .Recordset.Fields("csrq").Value = Trim(Text2.Text)
    If Text4.Text <> "" Then .Recordset.Fields("sfzh").Value = Trim(Text4.Text)
    If Text1.Text <> "" Then .Recordset.Fields("xm").Value = Trim(Text1.Text)
    If Combo1.Text <> "" Then .Recordset.Fields("xb").Value = Trim(Combo1.Text)
    If Text5.Text <> "" Then .Recordset.Fields("mz").Value = Trim(Text5.Text)
    If Text3.Text <> "" Then .Recordset.Fields("zz").Value = Trim(Text3.Text)
    .Recordset.Update
    .Refresh
End With
With cnn
    .Open constr
    .Execute "insert into bmb1 select * from bmb where sfzh='" & Trim(Text4.Text) & "'"
    .Close
End With
Set cnn = Nothing
    With Adobmb
        .ConnectionString = constr
        .RecordSource = "select * from bmb"
        .Refresh
    End With
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text1.SetFocus
Exit Sub
err1:
'    Dim cnn As New ADODB.Connection
'    With cnn
'        .Open constr
'        .Execute "select * from bmb"
    If Err.Number = -2147467259 Then
        MsgBox "身份证号为空或身份证号重复，请仔细检查。", vbInformation, "提示"
        Text4.SetFocus
        Exit Sub
    ElseIf Err.Number = -2147217887 Then
        MsgBox "出生日期格式错误，请改正！", vbInformation, "提示"
        Text2.SetFocus
        Exit Sub
   
    End If
'    End With
End Sub

Private Sub Form_Load()
With Adobmb
    .ConnectionString = constr
    .RecordSource = "select * from bmb"
    .Refresh
End With
Set DataGrid1.DataSource = Adobmb
Call cmddel
End Sub

Private Sub Text1_LostFocus()
If Len(Trim(Text1.Text)) > 10 Then
    MsgBox "输入的姓名过长，不符要求。", vbInformation, "提示"
    Text1.Text = ""
    Text1.SetFocus
    Exit Sub
End If
End Sub

Private Sub Text3_LostFocus()
If Len(Trim(Text3.Text)) > 50 Then
    MsgBox "输入的住址过长，不符要求。", vbInformation, "提示"
    Text3.Text = ""
    Text3.SetFocus
    Exit Sub
End If

End Sub

Private Sub Text4_LostFocus()
If Len(Trim(Text4.Text)) > 18 Then
    MsgBox "输入的身份证号过长，不符要求。", vbInformation, "提示"
    Text4.Text = ""
    Text4.SetFocus
    Exit Sub
End If
End Sub

Private Sub Text5_LostFocus()
If Len(Trim(Text5.Text)) > 20 Then
    MsgBox "输入的民族过长，不符要求。", vbInformation, "提示"
    Text5.Text = ""
    Text5.SetFocus
    Exit Sub
End If
End Sub

Private Sub Text6_LostFocus()
If Len(Trim(Text6.Text)) > 10 Then
    MsgBox "输入的姓名过长，不符要求。", vbInformation, "提示"
    Text6.Text = ""
    Text6.SetFocus
    Exit Sub
End If
End Sub

Private Sub Text7_LostFocus()
If Len(Trim(Text7.Text)) > 18 Then
    MsgBox "输入的身份证号过长，不符要求。", vbInformation, "提示"
    Text7.Text = ""
    Text7.SetFocus
    Exit Sub
End If
End Sub
Sub cmddel()
Dim cnn As New ADODB.Recordset
With cnn
    .ActiveConnection = constr
    .CursorLocation = adUseClient
    .CursorType = adOpenDynamic
    .LockType = adLockBatchOptimistic
    .Open "select * from sbqkb01"
    If Not (.EOF And .BOF) Then
        cmddelete.Enabled = False
    Else
        cmddelete.Enabled = True
    End If
    .Close
End With
Set cnn = Nothing
End Sub