m7.bas

办公自动化 vb+server2

Attribute VB_Name = "勘察"
Public Sub kancha1(username As String, MenuItem As Long)
 Select Case MenuItem
       Case 1
               If ii(62) = "1" Then
                 Form50.Show vbModal
                Else
                 MsgBox "没有权限进行该项操作！", vbInformation, "提示"
               End If
       Case 2
               If ii(63) = "1" Then
                 Form51.Show vbModal
                Else
                 MsgBox "没有权限进行该项操作！", vbInformation, "提示"
               End If
       Case 3
              If ii(64) = "1" Then
                 Form52.Show vbModal
                Else
                 MsgBox "没有权限进行该项操作！", vbInformation, "提示"
               End If
       Case 4
        Form2.VerticalMenu2(6).Visible = False
       Case 5
              If ii(68) = "1" Then
                 Form59.Show vbModal
                Else
                 MsgBox "没有权限进行该项操作！", vbInformation, "提示"
               End If
       Case 6
              If ii(69) = "1" Then
                 Form60.Show vbModal
                Else
                 MsgBox "没有权限进行该项操作！", vbInformation, "提示"
               End If
       Case 7
              If ii(70) = "1" Then
                 Form62.Show vbModal
                Else
                 MsgBox "没有权限进行该项操作！", vbInformation, "提示"
               End If
    End Select
End Sub
Public Sub kancha2(username As String, MenuItem As Long)
 Select Case MenuItem
       Case 1
               If ii(65) = "1" Then
                 Form55.Show vbModal
                  Else
                  MsgBox "没有权限进行该项操作！", vbInformation, "提示"
               End If
        Case 2
               If ii(73) = "1" Then
                 Form65.Show vbModal
                  Else
                  MsgBox "没有权限进行该项操作！", vbInformation, "提示"
               End If
        Case 3
               If ii(65) = "1" Then
                 Form57.Show vbModal
                  Else
                  MsgBox "没有权限进行该项操作！", vbInformation, "提示"
               End If
        Case 4
              If ii(73) = "1" Then
                 Form67.Show vbModal
                Else
                 MsgBox "没有权限进行该项操作！", vbInformation, "提示"
               End If
        Case 5
        Form2.VerticalMenu2(6).Visible = False
    End Select
End Sub

Public Sub kancha3(username As String, MenuItem As Long)
Dim str(1000)
Dim l As Integer
Dim zfm, zfm1 As String
Dim kong(100)
Dim max1, max2, max3, max1n, max2n, max3n As Integer
Dim s1, s2, s3, s4, s5, s6, z, s8, s9 As Integer
Dim z1, z2, z3, z4, z5, z6, z7, z8, z9 As String

max1n = 0
max2n = 0
max3n = 0
max4 = 0
max5 = 0
da = Date
da1 = left(da, 4)
'da2 = da1 & "-01-01"
'da3 = Format(da2, "yyyy-mm-dd")
 Select Case MenuItem
       Case 1
               If ii(74) = "1" Then
                SQL = "select  单位名称,工程编号,时间,院长签字,财务部差额 from 定线 where 时间 like '%" & da1 & "%' and 财务部='0' union all select  单位名称,工程编号,时间,院长签字,财务部差额 from 竣工 where 时间 like '%" & da1 & "%' and 财务部='0' union all select  单位名称,工程编号,时间,院长签字,财务部差额 from 零星验字工程 where 时间 like '%" & da1 & "%' and 财务部='0' union all select  单位名称,工程编号,时间,院长签字,财务部差额 from 建筑物位置测定 where 时间 like '%" & da1 & "%' and 财务部='0'union all select  单位名称,工程编号,时间,院长签字,财务部差额 from 地籍 where 时间 like '%" & da1 & "%' and 财务部='0' order by 工程编号"
                     grs.Open SQL, gconn, 1, 1
                    
                          If grs.RecordCount = "0" Then
                             MsgBox "没有数据！", vbInformation, "提示"
                             grs.Close
                            Exit Sub
                          End If
'                        For n = 1 To grs.RecordCount
'                            If grs("院长签字") = 0 Then
'                               str(n) = "正在进行中"
'                               Else
'                               str(n) = "已完成"
'                            End If
'
'                          Form2.ListView1(18).ListItems.Add , , n
'                         Form2.ListView1(18).ListItems.Item(n).SubItems(1) = grs("工程编号")
'                         Form2.ListView1(18).ListItems.Item(n).SubItems(2) = grs("单位名称")
'                         Form2.ListView1(18).ListItems.Item(n).SubItems(3) = str(n)
'                         grs.MoveNext
'                       Next
'                     grs.Close
'
'Dim myExcel As New Excel.Application
'Dim xlBook As Excel.Workbook '定义工件簿类
'Dim xlsheet As Excel.Worksheet '定义工作表类
'Dim r As Integer
'Dim col, zfm As String
'
'
'  With Form2.CommonDialog4
'  .Filter = "数据库文件(*.xls)|*.xls|" '在commondialog控件中过滤文件
'  .FilterIndex = 2
'  .ShowSave
'  End With
'If Form2.CommonDialog4.FileName = "" Then
'   MsgBox "你必须输入一个文件名，请重新保存一次！"
'   Exit Sub
'Else
'   zfm = Form2.CommonDialog4.FileName
'End If
'
'    Dim ex As Object
'    Dim exwbook As Object
'    Dim exsheet As Object
'    Set ex = CreateObject("Excel.Application")
'    Set exwbook = Nothing
'    Set exsheet = Nothing
'    Set exwbook = ex.Workbooks().Add
'    Set exsheet = exwbook.Worksheets("sheet1")
'
'''***********画字段************
'j = 0
'For i = 65 To 68 '从RS中头一个字段到最后一个
'col = Chr(i) & "1" 'Chr(66)就是B
'Range(col).Select
'ActiveCell.FormulaR1C1 = Form2.ListView1(18).ColumnHeaders.Item(i - 64).Text
'j = j + 1
'Next i
'''*************以先横后竖顺序画表***************
'For l = 1 To Form2.ListView1(18).ListItems.Count
'k = 0
'For i = 65 To 68
'col = Chr(i) & l + 1 '得到目标表格的值如 C3
'Range(col).Select
'If k = 0 Then
' ActiveCell.FormulaR1C1 = Form2.ListView1(18).ListItems.Item(l)
'End If
'If k <> 0 Then
' ActiveCell.FormulaR1C1 = Form2.ListView1(18).ListItems.Item(l).ListSubItems(k)
'End If
'k = k + 1
'Next i
'Next
''    exsheet.Visible = False '给excel表设置密码并且隐藏
''    exsheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=123 '给excel表设置密码并且保护
'    '保存输入到abc.xls
''    exwbook.SaveAs "c:\收案登记流水台帐"
'    exwbook.SaveAs zfm
'    '退出excel
'    ex.Quit

'////////////////
kong(1) = " "
kong(2) = "  "
kong(3) = "   "
kong(4) = "    "
kong(5) = "     "
kong(6) = "      "
kong(7) = "       "
kong(8) = "        "
kong(9) = "         "
kong(10) = "          "
kong(11) = "           "
kong(12) = "            "
kong(13) = "             "
kong(14) = "              "
kong(15) = "               "
kong(16) = "                "
kong(17) = "                 "
kong(18) = "                  "
kong(19) = "                   "
kong(20) = "                    "
kong(21) = "                     "
kong(22) = "                      "
kong(23) = "                       "
kong(24) = "                        "
kong(25) = "                         "
kong(26) = "                          "
kong(27) = "                           "
kong(28) = "                            "
kong(29) = "                             "
kong(30) = "                              "
kong(31) = "                               "
kong(32) = "                                "
kong(33) = "                                 "
kong(34) = "                                  "
kong(35) = "                                   "
kong(36) = "                                    "
kong(37) = "                                     "
kong(38) = "                                      "
kong(39) = "                                       "
kong(40) = "                                        "
kong(41) = "                                         "