⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 frmygxxgl.frm

📁 朋友给的
💻 FRM
📖 第 1 页 / 共 5 页
字号:
🔍
12345 
    Dim msg As String
    Dim strsql As String
    
    strsql = "select 工号,姓名 from  VIEWYGXX"
    If Trim(findbt) <> "" And Trim(findnr) <> "" Then
        strsql = strsql & " where " & findbt & " like '%" & findnr & "%' "
    End If
    rs.Open strsql, gCnn, adOpenStatic, adLockReadOnly
'    If rs.RecordCount = 1 Then
'        Call FillText(Findbt, Findnr)
    If rs.RecordCount > 0 Then
    
        msg = ShowListView(ListView1, rs, False, 1000)
    Else
        ClearText
        MsgBox "无记录", vbOKOnly, "系统提示"
   End If
End Sub

Private Sub DBRXB_Click(Index As Integer)
If DBRXB.Item(0).Value = True Then
  dbrxb1 = True
  Else
  dbrxb1 = False
  End If
End Sub

Private Sub Command5_Click()
    If GH = "" Then
        MsgBox "请输入工号!!", vbInformation, "系统提示"
        Exit Sub
    End If
    Dim rs As New ADODB.Recordset
    Set rs = New ADODB.Recordset
    rs.Open "select * from ygjbzl where th=1", gCnn, adOpenStatic, adLockReadOnly
    If Not rs.EOF Then
        MsgBox "该员工已经做了辞职操作！！", vbInformation, "系统提示"
        Exit Sub
    Else
        gCnn.Execute "update ygjbzl set th=1 where gh='" & GH & "'"
        MsgBox "辞职操作成功", vbInformation, "系统提示"
        Exit Sub
    End If
        
    
End Sub

Private Sub DBRSFZH_LostFocus()
    On Error GoTo err_Handle
'    If cboZjlx.Text = "身份证" Then
        If Trim(DBRSFZH) = "" Then
            MsgBox "请输入身份证（护照）号！", vbCritical, "系统提示"
            DBRSFZH.SetFocus
            Exit Sub
        Else
            If Len(Trim(DBRSFZH)) <> 15 And Len(Trim(DBRSFZH)) <> 18 Then
                MsgBox "身份证号为15位或者18位！", vbCritical, "系统提示 "
                DBRSFZH.SetFocus
                Exit Sub
            Else
                If Len(Trim(DBRSFZH)) = 18 And Right(Trim(DBRSFZH), 3) <> "000" Then
                   DBRCSNY = Format(DateSerial(Mid(Trim(DBRSFZH), 7, 4), Mid(Trim(DBRSFZH), 11, 2), Mid(Trim(DBRSFZH), 13, 2)), "yyyy-MM-dd")
                   'FZRNL = Year(Date) - Val(Mid(Trim(XH), 7, 4))
                   If Mid(Trim(DBRSFZH), 17, 1) Mod 2 = 0 Then
                      Option4.Value = True
                   Else
                      Option3.Value = True
                      
                    End If
                Else
                   DBRCSNY = Format(DateSerial(Mid(Trim(DBRSFZH), 7, 2), Mid(Trim(DBRSFZH), 9, 2), Mid(Trim(DBRSFZH), 11, 2)), "yyyy-MM-dd")
                   
                   If Right(Trim(DBRSFZH), 3) = "000" Then
                     If Mid(Trim(DBRSFZH), 15, 1) Mod 2 = 0 Then
                        Option4.Value = True
                     Else
                        Option3.Value = True
                     End If
                  Else
                     If Right(Trim(DBRSFZH), 1) Mod 2 = 0 Then
                        Option4.Value = True
                     Else
                        Option3.Value = True
                     End If
                  End If
                End If
               End If
            End If
        'End If
        Exit Sub
err_Handle:
    If Err.Number = 13 Then
       MsgBox "确认身份证号是否正确!", vbInformation, "系统提示"
       DBRSFZH.SetFocus
    Else
       MsgBox Err.Description, vbInformation, "系统提示"
    End If







End Sub

Private Sub EMAIL_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
         KL.Tab = 1
         SendKeys "{tab}"
    End If


End Sub

Private Sub Form_Load()
    If Me.WindowState = 0 Then Me.Move 0, 0, 12765, 6990
    CSNY = Now '    XB.Item(0).Value = True

'    xb1 = True
'    DBRXB.Item(0).Value = True
'    dbrxb1 = True
    KL.Tab = 0
    RSRQ = Now
    LDDLRQ = Now
    DBRCSNY = Now
    Dim rs As New ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim strsql As String
    Dim i As Long
    strsql = "select value from PARAMETERS where paratype=4 order by valueid"
    rs.Open strsql, gCnn, adOpenStatic, adLockReadOnly
    YWZJ.Clear
    For i = 0 To rs.RecordCount - 1
        YWZJ.AddItem rs(0)
        rs.MoveNext
    Next
    If rs.State = 1 Then rs.Close
    strsql = "select value from PARAMETERS where paratype=5 order by valueid"
    rs.Open strsql, gCnn, adOpenStatic, adLockReadOnly
    ZC.Clear
    For i = 0 To rs.RecordCount - 1
        ZC.AddItem rs(0)
        rs.MoveNext
    Next
    
    If rs.State = 1 Then rs.Close
    strsql = "select tdmc,id from tdgl order by id"
    rs.Open strsql, gCnn, adOpenStatic, adLockReadOnly
    SSTD.Clear
    For i = 0 To rs.RecordCount - 1
        SSTD.AddItem rs(0)
        SSTD.ItemData(i) = rs(1)
        rs.MoveNext
    Next
    If rs.State = 1 Then rs.Close
    strsql = "select id,bmmc from bmgl order by id"
    rs.Open strsql, gCnn, adOpenStatic, adLockReadOnly
    BM.Clear
    For i = 0 To rs.RecordCount - 1
        BM.AddItem rs(1)
        BM.ItemData(i) = rs(0)
        rs.MoveNext
    Next
    
    
    
    If rs.State = 1 Then rs.Close
    rs.Open "select * from VIEWYGXX ", gCnn, adOpenStatic, adLockReadOnly
    findbt.Clear
    For i = 0 To rs.Fields.count - 1
        findbt.AddItem rs.Fields(i).name
    Next
    
    Dim msg As String
    strsql = "select 工号,姓名 from  VIEWYGXX"
    msg = ShowListView(ListView1, rs, False, "1000,2000")
    
    
    
    
     
End Sub



Private Sub GH_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then SendKeys "{Tab}"

End Sub






Private Sub Image1_DblClick()
   On Error GoTo ExitNow
   Dim filedir As String
'   Dim Filename As String
   Dim fso As New FileSystemObject
   Dim DestPFld As Scripting.Folder, DestFld As Scripting.Folder
   
   CommonDialog1.Filter = "BitMaps|*.bmp|JPEG|*.jpg|GIF|*.gif"
   CommonDialog1.FilterIndex = 2
   CommonDialog1.DialogTitle = "选择源文件!"
   CommonDialog1.CancelError = True
   CommonDialog1.ShowOpen
   Filename = CommonDialog1.Filename
   
   
   Image1.Picture = LoadPicture(Filename)
  
  '========保存图片===========

   Open Filename For Binary As #1
     
   If FileLen(Filename) = 0 Then
     MsgBox "空图片!", vbInformation, "系统提示"
   Else
     ReDim pic(FileLen(Filename))
     Label20.Visible = False
     Get #1, , pic
   End If
   
   Close #1
  
  '========保存图片===========
ExitNow:
   ' MsgBox Err.Description
End Sub

Private Sub Image2_DblClick()
   On Error GoTo ExitNow
   Dim filedir As String
'   Dim Filename As String
   Dim fso As New FileSystemObject
   Dim DestPFld As Scripting.Folder, DestFld As Scripting.Folder
   
   CommonDialog2.Filter = "BitMaps|*.bmp|JPEG|*.jpg|GIF|*.gif"
   CommonDialog2.FilterIndex = 2
   CommonDialog2.DialogTitle = "选择源文件!"
   CommonDialog2.CancelError = True
   CommonDialog2.ShowOpen
   Filename1 = CommonDialog2.Filename
   
   
   Image2.Picture = LoadPicture(Filename1)
  
  '========保存图片===========

   Open Filename1 For Binary As #1
     
   If FileLen(Filename1) = 0 Then
     MsgBox "空图片!", vbInformation, "系统提示"
   Else
     ReDim pic1(FileLen(Filename1))
     Label31.Visible = False
     Get #1, , pic1
   End If
   
   Close #1
  
  '========保存图片===========
ExitNow:






End Sub

Private Sub Label20_Click()
    Call Image1_DblClick

End Sub

Private Sub Label31_DblClick()
Image2_DblClick
End Sub

Private Sub SFZH_LostFocus()
    On Error GoTo err_Handle
'    If cboZjlx.Text = "身份证" Then
        If Trim(SFZH) = "" Then
            MsgBox "请输入身份证（护照）号！", vbCritical, "系统提示"
            SFZH.SetFocus
            Exit Sub
        Else
            If Len(Trim(SFZH)) <> 15 And Len(Trim(SFZH)) <> 18 Then
                MsgBox "身份证号为15位或者18位！", vbCritical, "系统提示 "
                SFZH.SetFocus
                Exit Sub
            Else
                If Len(Trim(SFZH)) = 18 And Right(Trim(SFZH), 3) <> "000" Then
                   CSNY = Format(DateSerial(Mid(Trim(SFZH), 7, 4), Mid(Trim(SFZH), 11, 2), Mid(Trim(SFZH), 13, 2)), "yyyy-MM-dd")
                   'FZRNL = Year(Date) - Val(Mid(Trim(XH), 7, 4))
                   If Mid(Trim(SFZH), 17, 1) Mod 2 = 0 Then
                      Option2.Value = True
                   Else
                      Option1.Value = True
                      
                    End If
                Else
                   CSNY = Format(DateSerial(Mid(Trim(SFZH), 7, 2), Mid(Trim(SFZH), 9, 2), Mid(Trim(SFZH), 11, 2)), "yyyy-MM-dd")
                   
                   If Right(Trim(SFZH), 3) = "000" Then
                     If Mid(Trim(SFZH), 15, 1) Mod 2 = 0 Then
                        Option2.Value = True
                     Else
                        Option1.Value = True
                     End If
                  Else
                     If Right(Trim(SFZH), 1) Mod 2 = 0 Then
                        Option2.Value = True
                     Else
                        Option1.Value = True
                     End If
                  End If
                End If
               End If
            End If
        'End If
        Exit Sub
err_Handle:
    If Err.Number = 13 Then
       MsgBox "确认身份证号是否正确!", vbInformation, "系统提示"
       SFZH.SetFocus
    Else
       MsgBox Err.Description, vbInformation, "系统提示"
    End If

End Sub

Private Sub XB_Click(Index As Integer)
If XB.Item(0).Value = True Then
   xb1 = True
   Else
   xb1 = False
   End If
End Sub
Private Sub ClearText()
     GH = ""
        XM = ""
        BM = ""
        ZC = ""
        CSNY = Now
'        XB.Item(0).Value = True
        
        HYZK = ""
         YB = ""
         SFZH = ""
        ADDRESS = ""
        GDDH = ""
        SJ = ""
        HJSZ = ""
        MZ = ""
        WHCD = ""
        RSRQ = Now
        ZZMM = ""
        DLZH = ""
        ZYZH = ""
        JYJL = ""
        GZJL = ""
        JCJL = ""
        PXJL = ""
        LDDLRQ = Now
        MEMO = ""
        DBRXH = ""
        DBRXM = ""
        DBRGZDW = ""
        DBRZC = ""
        DBRCSNY = Now
'        DBRXB.Item(0).Value = True
        DBRBGDH = ""
         DBRYB = ""
         DBRZZDH = ""
        DBRADDRESS = ""
        DBRSFZH = ""
        DBRSJ = ""
        DBRHJSZ = ""
        DBRMQDZ = ""
        YBDBRGX = ""
12345

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -