用户申告查询.frm

部门在用的用户申告系统

Cmdprint.Enabled = False
db.Execute "delete from temp_jfsg"
Set rsls = db.OpenRecordset("select sgnr,sgsj,clff,cljg,clr,clsj,sm,jm,lxr,jflxid,id,fwbh from temp_jfsg")
Set Data1.Recordset = rsls
Data1.Refresh
Call biaotou

'写入树型目录
Dim i As Integer
'Dim xnod As Nodes
Dim rs1 As Recordset
Dim rs2 As Recordset
Dim rs3 As Recordset
Dim str As String
i = 1
Dim Xnod1 As Node
Dim Xnod2 As Node
Dim Xnod3 As Node
Dim xnod4 As Node
Set Xnod1 = TVw.Nodes.Add(, tvwLast, "q", "全国", 1)
Set rs1 = db.OpenRecordset("select distinct sm from jfxx")
Do While Not rs1.EOF
   str = "w" & CStr(i)
   Set Xnod2 = TVw.Nodes.Add(Xnod1, tvwChild, str, rs1.Fields!sm, 2)
   Set rs2 = db.OpenRecordset("select distinct jm,id from jfxx where sm='" & rs1.Fields!sm & "'")
   Do While Not rs2.EOF
      str = "s" & CStr(i)
      Set Xnod3 = TVw.Nodes.Add(Xnod2, tvwChild, str, rs2.Fields!jm, 3)
      Set rs3 = db.OpenRecordset("select distinct lxr,id from jflx where jfxxid=" & rs2.Fields!id)
      Do While Not rs3.EOF
         str = "l" & CStr(i)
         Set xnod4 = TVw.Nodes.Add(Xnod3, tvwChild, str, rs3.Fields!lxr & "@" & rs3.Fields!id, 4)
         i = i + 1
         rs3.MoveNext
      Loop
      rs3.Close
      i = i + 1
      rs2.MoveNext
   Loop
   rs2.Close
   i = i + 1
   rs1.MoveNext
Loop
rs1.Close

Combocljg.AddItem "已处理"
Combocljg.AddItem "未处理"
Combocljg.AddItem "待观察"
Combocljg.Text = "已处理"

Combojg.AddItem "已处理"
Combojg.AddItem "未处理"
Combojg.AddItem "待观察"
Combojg.Text = "已处理"

Comboclr.AddItem "王顺利"
Comboclr.AddItem "何  伟"
Comboclr.AddItem "时金轩"
Comboclr.Text = "王顺利"

DTPick1.Value = Date
DTPick2.Value = Date
End Sub

Private Sub Form_Resize()
Dim x1 As Integer
Dim x2 As Integer
Dim height1 As Integer
Dim width1 As Integer
Dim width2 As Integer
On Error Resume Next
height1 = ScaleHeight - (CTRL_OFFSET * 2)
x1 = CTRL_OFFSET
width1 = TVw.Width

x2 = x1 + TVw.Width + SPLT_WDTH - 1
width2 = ScaleWidth - x2 - CTRL_OFFSET

TVw.Move x1% - 1, CTRL_OFFSET, width1, height1

Pic2.Move x2, CTRL_OFFSET, width2 + 1, height1

Pic1.Move x1 + TVw.Width - 1, CTRL_OFFSET, SPLT_WDTH, height1
End Sub

Private Sub Form_Unload(Cancel As Integer)
MDIFrm.numsgcx.Enabled = True
rsls.Close
MDIFrm.Caption = App.Title
End Sub
Private Sub biaotou()
DBGrid.Columns(0).Caption = "申告内容"
DBGrid.Columns(0).Width = DBGrid.Width * (2400 / 8700)
'DBGrid.Columns(0).Alignment = dbgCenter
DBGrid.Columns(1).Caption = "申告时间"
DBGrid.Columns(1).Width = DBGrid.Width * (1000 / 8700) '1000
DBGrid.Columns(1).Alignment = dbgCenter
DBGrid.Columns(2).Caption = "处理方法"
DBGrid.Columns(2).Width = DBGrid.Width * (1000 / 8700) '1000
'DBGrid.Columns(2).Alignment = dbgCenter
DBGrid.Columns(3).Caption = "处理结果"
DBGrid.Columns(3).Width = DBGrid.Width * (900 / 8700) '700
DBGrid.Columns(3).Alignment = dbgCenter
DBGrid.Columns(4).Caption = "处理人"
DBGrid.Columns(4).Width = DBGrid.Width * (700 / 8700) '700
DBGrid.Columns(4).Alignment = dbgCenter
DBGrid.Columns(5).Caption = "处理时间"
DBGrid.Columns(5).Width = DBGrid.Width * (1000 / 8700) '1000
DBGrid.Columns(5).Alignment = dbgCenter
DBGrid.Columns(6).Caption = "省名"
DBGrid.Columns(6).Width = 900
DBGrid.Columns(6).Alignment = dbgCenter
DBGrid.Columns(6).Visible = False
DBGrid.Columns(7).Caption = "局名"
DBGrid.Columns(7).Width = 1000
DBGrid.Columns(7).Alignment = dbgCenter
DBGrid.Columns(7).Visible = False
DBGrid.Columns(8).Caption = "联系人"
DBGrid.Columns(8).Width = 1000
DBGrid.Columns(8).Alignment = dbgCenter
DBGrid.Columns(8).Visible = False
DBGrid.Columns(9).Caption = "联系人ID"
DBGrid.Columns(9).Width = 1000
DBGrid.Columns(9).Alignment = dbgCenter
DBGrid.Columns(9).Visible = False
DBGrid.Columns(10).Caption = "ID"
DBGrid.Columns(10).Width = 1000
DBGrid.Columns(10).Alignment = dbgCenter
DBGrid.Columns(10).Visible = False
DBGrid.Columns(11).Caption = "服务\信息卡"
DBGrid.Columns(11).Width = DBGrid.Width * (1200 / 8700) ' 1200
DBGrid.Columns(11).Alignment = dbgCenter

End Sub

Private Sub Pic1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
    '左键按下
    Pic1.BackColor = SPLT_COLOUR
    currSplitPosX = CLng(X)
Else
    'not the left button, so... if the current position <> default, cause a mouseup
    If currSplitPosX <> &H7FFFFFFF Then Pic1_MouseUp Button, Shift, X, Y
    
    'set the current position to the default value
    currSplitPosX = &H7FFFFFFF
End If

End Sub

Private Sub Pic1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'if the splitter has been moved...
If currSplitPosX& <> &H7FFFFFFF Then

        'if the current position <> default, reposition the splitter and set this as the current value
        If CLng(X) <> currSplitPosX Then
                Pic1.Move Pic1.Left + X, CTRL_OFFSET, SPLT_WDTH, ScaleHeight - (CTRL_OFFSET * 2)
                currSplitPosX = CLng(X)
                DBGrid.Width = DBGrid.Width - X
                Line2.x2 = Line2.x2 - X
        End If
End If
End Sub

Private Sub Pic1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'if the splitter has been moved...
If currSplitPosX <> &H7FFFFFFF Then
'if the current postition <> the last position do a final move of the splitter
If CLng(X) <> currSplitPosX Then
    Pic1.Move Pic1.Left + X, CTRL_OFFSET, SPLT_WDTH, ScaleHeight - (CTRL_OFFSET * 2)
End If

'call this the default position
currSplitPosX = &H7FFFFFFF

'restore the normal splitter colour
Pic1.BackColor = &H8000000F

'and check for valid sizings.
'Either enforce the default minimum & maximum widths for the left list, or, if within range, set the width

'If Pic1.Left > 1500 And Pic1.Left < (ScaleWidth - 6000) Then
If Pic1.Left > 60 And Pic1.Left < (ScaleWidth - 60) Then

TVw.Width = Pic1.Left - TVw.Left 'the pane is within range


ElseIf Pic1.Left < 60 Then 'the pane is too small
    TVw.Width = 60
Else
    TVw.Width = ScaleWidth - 60 'the pane is too wide
End If
    'reposition both lists, and the splitter bar
    Form_Resize
    Call biaotou
End If
End Sub

Private Sub TVw_Click()
Dim strsql As String
Dim paixu As String
If biaodian = True Then
   If biaodian2 = True Then
      paixu = " order by " & biaoji & " ASC"
    Else
      paixu = " order by " & biaoji & " DESC"
    End If
Else
    paixu = " order by sgsj asc"
End If
strsql = ""
cxsj1 = Format(DTPick1, "yyyy-mm-dd")
cxsj2 = Format(DTPick2, "yyyy-mm-dd")

If Chkcx.Value = 1 Then
   tjrq = "查询日期：" & Format(DTPick1.Value, "yyyy-mm-dd") & "至" & Format(DTPick2.Value, "yyyy-mm-dd")
Else
   tjrq = ""
End If

If Chkcx.Value = 1 Then
   strsql = " and sgsj between #" & cxsj1 & "# and #" & cxsj2 & "#"
   If Chkcl.Value = 1 Then
      strsql = strsql & " and cljg='" & Trim(Combocljg.Text) & "'"
   End If
  Else
   If Chkcl.Value = 1 Then
      strsql = " and cljg='" & Trim(Combocljg.Text) & "'"
   End If
End If
db.Execute "delete from temp_jfsg"
Dim str1 As String
str1 = TVw.SelectedItem.Text
Dim str2 As String
str2 = TVw.Nodes(TVw.SelectedItem.Index).Key
str2 = Left(str2, 1)
If str1 = "全国" Then
   Set rsls = db.OpenRecordset("select sgnr,sgsj,clff,cljg,clr,clsj,sm,jm,lxr,jflxid,jfsg.id,fwbh " _
            & "from jfsg,jflx,jfxx where jflxid=jflx.id and jfxxid=jfxx.id" & strsql & paixu)
End If
If str2 = "w" Then
   Set rsls = db.OpenRecordset("select sgnr,sgsj,clff,cljg,clr,clsj,sm,jm,lxr,jflxid,jfsg.id,fwbh " _
            & "from jfsg,jflx,jfxx where jflxid=jflx.id and jfxxid=jfxx.id and sm='" & str1 & "'" & strsql & paixu)
End If
If str2 = "s" Then
   Set rsls = db.OpenRecordset("select sgnr,sgsj,clff,cljg,clr,clsj,sm,jm,lxr,jflxid,jfsg.id,fwbh " _
            & "from jfsg,jflx,jfxx where jflxid=jflx.id and jfxxid=jfxx.id and jm='" & str1 & "'" & strsql & paixu)
End If
If str2 = "l" Then
   Dim zuostr As String '联系人
   Dim youstr As String '联系人ID
   Dim bianliang As String
   bianliang = str1
   youstr = cxlxrid(str1)
   zuostr = cxlxrid2(bianliang)
   str1 = zuostr
   Set rsls = db.OpenRecordset("select sgnr,sgsj,clff,cljg,clr,clsj,sm,jm,lxr,jflxid,jfsg.id,fwbh " _
            & "from jfsg,jflx,jfxx where jflxid=jflx.id and jfxxid=jfxx.id and lxr='" & str1 & "' and jflxid=" & youstr & strsql & paixu)
   
End If
Set Data1.Recordset = rsls
Data1.Refresh
bh = True
biaodian = False
Call biaotou

End Sub

Private Sub bijiaotime1()
If DTPicksgsj.Value > DTPickclsj.Value Then
   MsgBox "申告日期:" & DTPicksgsj.Value & " 大于 处理日期" & DTPickclsj.Value, vbInformation, "信息"
End If
End Sub

Private Function bijiaotime() As Integer
If DTPicksgsj.Value > DTPickclsj.Value Then
   MsgBox "申告日期:" & DTPicksgsj.Value & " 大于 处理日期" & DTPickclsj.Value, vbInformation, "信息"
   bijiaotime = 1
Else
   bijiaotime = 0
End If

End Function

Private Function tongjifl() As String
Dim rs1 As Recordset
Dim str1 As String
Set rs1 = db.OpenRecordset("select count(*) as cs from temp_jfsg where len(fwbh)=0")
str1 = "一般申告信息 " & rs1.Fields!cs & " 条    "
rs1.Close
Set rs1 = db.OpenRecordset("select count(*) as cs from temp_jfsg where len(fwbh)=10")
str1 = str1 & "工程服务卡信息 " & rs1.Fields!cs & " 条    "
rs1.Close
Set rs1 = db.OpenRecordset("select count(*) as cs from temp_jfsg where len(fwbh)=13")
str1 = str1 & "发往开发部信息 " & rs1.Fields!cs & " 条    "
rs1.Close
tongjifl = str1
End Function

Private Sub tianjiajl()
Dim rs As Recordset
Set rs = db.OpenRecordset("temp_jfsg")
db.Execute "delete from temp_jfsg"
With rsls
.MoveFirst
Do While Not .EOF
   If rs.RecordCount > 0 Then
      rs.MoveLast
   End If
   rs.AddNew
   rs.Fields!sgnr = .Fields!sgnr
   rs.Fields!sgsj = .Fields!sgsj
   rs.Fields!clff = .Fields!clff
   rs.Fields!cljg = .Fields!cljg
   rs.Fields!clr = .Fields!clr
   rs.Fields!clsj = .Fields!clsj
   rs.Fields!sm = .Fields!sm
   rs.Fields!jm = .Fields!jm
   rs.Fields!lxr = .Fields!lxr
   'rs.Fields!jflxid = .Fields!jflxid
   'rs.Fields!id = .Fields!id
   rs.Fields!fwbh = .Fields!fwbh
   rs.Update
   .MoveNext
Loop
End With
rs.Close
End Sub