用户申告查询.frm

部门在用的用户申告系统

         Height          =   255
         Left            =   480
         TabIndex        =   28
         Top             =   4920
         Width           =   855
      End
      Begin VB.Label Label7 
         Caption         =   "处理时间"
         Height          =   375
         Left            =   4800
         TabIndex        =   27
         Top             =   2640
         Width           =   855
      End
      Begin VB.Line Line2 
         BorderColor     =   &H00FF8080&
         X1              =   120
         X2              =   8400
         Y1              =   5400
         Y2              =   5400
      End
      Begin VB.Label Label8 
         Caption         =   "省    名："
         Height          =   375
         Left            =   480
         TabIndex        =   26
         Top             =   2280
         Width           =   975
      End
      Begin VB.Label Label9 
         Caption         =   "无"
         Height          =   375
         Left            =   1440
         TabIndex        =   25
         Top             =   2280
         Width           =   1455
      End
      Begin VB.Label Label10 
         Caption         =   "局    名："
         Height          =   375
         Left            =   4800
         TabIndex        =   24
         Top             =   2280
         Width           =   975
      End
      Begin VB.Label Label11 
         Caption         =   "无"
         Height          =   375
         Left            =   5760
         TabIndex        =   23
         Top             =   2280
         Width           =   2295
      End
   End
End
Attribute VB_Name = "Frmsgcx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rsls As Recordset
Dim cxsj1, cxsj2, cxjg As String
Dim bh As Boolean
Dim tjrq As String
Dim biaodian As Boolean
Dim biaodian2 As Boolean
Dim biaoji As String
Dim dian2 As Boolean '点第二次

'添加控件拖动
Private Const SPLT_WDTH As Integer = 20
Private currSplitPosX As Long
Dim CTRL_OFFSET As Integer
Dim SPLT_COLOUR As Long

Private Sub Cmddel_Click()
On Error GoTo err
If MsgBox("确认要删除吗？", vbQuestion + vbYesNo) = vbYes Then
   MousePointer = vbHourglass
   db.Execute "delete from jfsg where id=" & Data1.Recordset.Fields!id
   Data1.Refresh
   Call biaotou
   DTPicksgsj.Value = Date
   DTPickclsj.Value = Date
   Txtsgnr.Text = ""
   Txtclff.Text = ""
   Txtfwk.Text = ""
   MousePointer = vbDefault
   If Data1.Recordset.RecordCount = 0 Then
      Cmddel.Enabled = False
      Cmdprint.Enabled = False
      Cmdupdate.Enabled = False
   End If
End If
Exit Sub

err:
    MousePointer = vbDefault
    MsgBox "请选择要删除的录！", vbExclamation, "错误提示"
End Sub

Private Sub Cmdexit_Click()
Unload Me
End Sub

Private Sub Cmdfh_Click()
DBGrid.Height = 4815
End Sub

Private Sub Cmdprint_Click()
'发生错误
On Error GoTo errprint
MousePointer = vbHourglass

Call tianjiajl

Dim fltj As String '分类统计
fltj = tongjifl

Report1.DataFiles(0) = App.Path & "\yhsg.mdb"
Report1.ReportFileName = App.Path & "\rpt\sgcx.rpt"
Report1.Formulas(0) = "tjrq='" & tjrq & "'"
Report1.Formulas(1) = "fltj='" & fltj & "'"  '分类统计信息
MousePointer = vbDefault
Dim Msg As Integer
Msg = MsgBox("要预览吗？", vbYesNoCancel)
If Msg = vbYes Or Msg = vbNo Then
   If Msg = vbNo Then
      Report1.Destination = crptToPrinter
    Else
      Report1.Destination = crptToWindow
   End If
   Report1.Action = 1
End If
Exit Sub

errprint:
    MousePointer = vbDefault
    If err.Number = 20513 Then
       MsgBox "打印机未准备好", vbOKOnly + vbCritical, "警告"
    Else
    errnb = err.Number
    errds = err.Description
    MsgBox errnb & errds, vbOKOnly
    End If
End Sub

Private Sub Cmdupdate_Click()
On Error GoTo err

If Txtsgnr.Text = "" Then
   MsgBox "申告内容不能为空！", vbInformation, "信息"
   Txtsgnr.SetFocus
   Exit Sub
End If
Dim sgnr, clff, fwk, sgsj, clsj, jg, clr As String
sgnr = Trim(Txtsgnr.Text)
sgsj = Format(DTPicksgsj.Value, "yyyy-mm-dd")
clsj = Format(DTPickclsj.Value, "yyyy-mm-dd")
If Txtclff.Text <> "" Then
   clff = Trim(Txtclff.Text)
 Else
   clff = ""
End If
If Txtfwk.Text <> "" Then
   fwk = Trim(Txtfwk.Text)
 Else
   fwk = ""
End If
jg = Trim(Combojg.Text)
clr = Trim(Comboclr.Text)

'检测服务卡数据
Dim fwk2 As String
Dim rsfwk As Recordset
fwk2 = Trim(Txtfwk.Text)
If fwk2 > "" Then
   If Chkbj.Value = 1 Then
      If Len(fwk2) <> 13 Then
         Txtfwk.SetFocus
         MsgBox "发往开发部信息卡格式不正确！", vbExclamation, "错误信息"
         Exit Sub
      End If
   Else
      If Len(fwk2) <> 10 Then
         Txtfwk.SetFocus
         MsgBox "发往开发部信息卡格式不正确！", vbExclamation, "错误信息"
         Exit Sub
      End If
   End If
   Set rsfwk = db.OpenRecordset("select fwbh from jfsg where fwbh>'' and fwbh='" & fwk2 & "'")
   If rsfwk.RecordCount > 0 Then
      rsfwk.Close
      Txtfwk.SetFocus
      MsgBox "服务卡或信息卡编号重复！", vbExclamation, "错误信息"
      Exit Sub
   End If
   rsfwk.Close
End If

If bijiaotime = 1 Then '比较申告时间和处理时间
   Exit Sub
End If

If MsgBox("确认要修改吗？", vbQuestion + vbYesNo) = vbYes Then
   Dim jl As Integer
   jl = Data1.Recordset.Fields!id
   MousePointer = vbHourglass
   db.Execute "update jfsg set sgnr='" & sgnr & "',sgsj='" & sgsj & "',clsj='" & clsj _
              & "',clff='" & clff & "',fwbh='" & fwk & "',cljg='" & jg & "',clr='" & clr _
              & "' where id=" & Data1.Recordset.Fields!id
   Data1.Refresh
   Data1.Recordset.MoveFirst
   If Data1.Recordset.RecordCount > 0 Then
      Do While Not Data1.Recordset.EOF
         If Data1.Recordset.Fields!id = jl Then
            Exit Do
          Else
            Data1.Recordset.MoveNext
         End If
      Loop
   End If
   Call biaotou
   MousePointer = vbDefault
   MsgBox "修改成功", vbInformation, "成功信息"
End If
Exit Sub

err:
    MousePointer = vbDefault
    MsgBox "请选择需要修改的记录！", vbExclamation, " 错误信息"

End Sub

Private Sub Cmdxx_Click()
DBGrid.Height = 1455
End Sub

Private Sub DBGrid_HeadClick(ByVal ColIndex As Integer)
If DBGrid.Columns(ColIndex).DataField = "sgnr" Or DBGrid.Columns(ColIndex).DataField = "clff" Then
    Exit Sub
Else
    biaodian = True
    If biaoji = DBGrid.Columns(ColIndex).DataField Then
       biaodian2 = True
       If dian2 = True Then
          biaodian2 = False
          dian2 = False
        Else
          biaodian2 = True
          dian2 = True
       End If
      Else
       biaodian2 = False
    End If
    biaoji = DBGrid.Columns(ColIndex).DataField
    Call TVw_Click
End If
End Sub

Private Sub DBGrid_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
On Error GoTo err
If bh = True Then
   If Data1.Recordset.RecordCount > 0 Then
       Cmdprint.Enabled = True
       Cmdupdate.Enabled = True
       Cmddel.Enabled = True
        With Data1.Recordset
         DTPicksgsj.Value = .Fields!sgsj
         DTPickclsj.Value = .Fields!clsj
         Txtsgnr.Text = .Fields!sgnr
         Txtclff.Text = .Fields!clff
         Txtfwk.Text = .Fields!fwbh
         If Len(.Fields!fwbh) = 13 Then
            Chkbj.Value = 1
         Else
            Chkbj.Value = 0
         End If
         Combojg.Text = .Fields!cljg
         Comboclr.Text = .Fields!clr
'         Dim rsjm As Recordset
'         Set rsjm = db.OpenRecordset("select sm,jm from jfxx,jflx where jfxx.id=jflx.jfxxid and jflx.id=" & .Fields!jflxid)
'         Label9.Caption = rsjm.Fields!sm
'         Label11.Caption = rsjm.Fields!jm
'         rsjm.Close
          Label9.Caption = .Fields!sm
          Label11.Caption = .Fields!jm
         End With
        Call bijiaotime
     Else
         DTPicksgsj.Value = Date
         DTPickclsj.Value = Date
         Txtsgnr.Text = ""
         Txtclff.Text = ""
         Txtfwk.Text = ""
         Cmdprint.Enabled = False
         Cmddel.Enabled = False
         Cmdupdate.Enabled = False
         Label9.Caption = "无"
         Label11.Caption = "无"
    End If
End If
Exit Sub

err:
   DTPicksgsj.Value = Date
   DTPickclsj.Value = Date
   Txtsgnr.Text = ""
   Txtclff.Text = ""
   Txtfwk.Text = ""
   MsgBox err.Description
End Sub

Private Sub Form_Load()
Pic1.MousePointer = 9 '设定鼠标为双箭头
CTRL_OFFSET = 5
SPLT_COLOUR = &H808080
currSplitPosX = &H7FFFFFFF
Line2.x2 = DBGrid.Width

biaodian = False
biaodian2 = False
MDIFrm.numsgcx.Enabled = True
MDIFrm.Caption = MDIFrm.Caption & "---[用户申告查询]"
tjrq = ""
DBGrid.Height = 4815
DBGrid.Width = 8700
Me.Top = 50
Me.Left = 0
Me.Height = 6525
Me.Width = 11895