form64.frm

办公自动化 vb+server2

    fk13 = right(fk11, fk1 - 5)
    fk2 = Len(fk13)
    SearchString = fk13 ' 被搜索的字符串。
    SearchChar = "-"   ' 要查找字符串 "P"。
    MyPos = InStr(1, SearchString, SearchChar, 1)
    fk14 = left(fk13, MyPos - 1)
    fk15 = right(fk13, fk2 - MyPos)
    fk16 = fk12 & "-" & fk14 & "-" & fk15
    da1 = Format(fk11, "yyyy-mm-dd")
    da2 = Format(mvda1, "yyyy-mm-dd")
    da3 = Format(mvda2, "yyyy-mm-dd")
    If da1 >= da2 And da1 <= da3 Then
      j = j + 1
        
        For m = 3 To 6
            mm(m) = mm(m) + hzrs.Fields(m).Value
        Next
        For n = 26 To 41
            mm(n) = mm(n) + hzrs.Fields(n).Value
        Next
            mm(54) = mm(54) + hzrs.Fields(54).Value
            mm(58) = mm(58) + hzrs.Fields(58).Value
            mm(62) = mm(62) + hzrs.Fields(62).Value
            mm(66) = mm(66) + hzrs.Fields(66).Value
            mm(70) = mm(70) + hzrs.Fields(70).Value
            mm(74) = mm(74) + hzrs.Fields(74).Value
            mm(75) = mm(75) + hzrs.Fields(75).Value
            mm(76) = mm(76) + hzrs.Fields(76).Value
            
    End If
   End If
   hzrs.MoveNext
Next
hzrs.Close

Dim ln As Long
If j = 0 Then
  ln = MsgBox("没有要统计的数据！", vbInformation, "提示")
  Exit Sub
End If
If j <> 0 Then
    Form64.ListView1.ListItems.Add 1, , mm(3)
    Form64.ListView1.ListItems.Item(1).SubItems(1) = mm(4)
    Form64.ListView1.ListItems.Item(1).SubItems(2) = mm(5)
    Form64.ListView1.ListItems.Item(1).SubItems(3) = mm(6)
    
   Form64.ListView1.ListItems.Item(1).SubItems(4) = mm(26) '技术所
   Form64.ListView1.ListItems.Item(1).SubItems(5) = mm(27)
   Form64.ListView1.ListItems.Item(1).SubItems(6) = mm(28)
   Form64.ListView1.ListItems.Item(1).SubItems(7) = mm(29)
   Form64.ListView1.ListItems.Item(1).SubItems(8) = mm(54)
   Form64.ListView1.ListItems.Item(1).SubItems(9) = mm(58)
   Form64.ListView1.ListItems.Item(1).SubItems(10) = mm(30)
   
   Form64.ListView1.ListItems.Item(1).SubItems(11) = mm(31) '劳务所
   Form64.ListView1.ListItems.Item(1).SubItems(12) = mm(32)
   Form64.ListView1.ListItems.Item(1).SubItems(13) = mm(33)
   Form64.ListView1.ListItems.Item(1).SubItems(14) = mm(34)
   Form64.ListView1.ListItems.Item(1).SubItems(15) = mm(62)
   Form64.ListView1.ListItems.Item(1).SubItems(16) = mm(66)
   Form64.ListView1.ListItems.Item(1).SubItems(17) = mm(35)
   
   Form64.ListView1.ListItems.Item(1).SubItems(18) = mm(36) '土工试验室
   Form64.ListView1.ListItems.Item(1).SubItems(19) = mm(37)
   Form64.ListView1.ListItems.Item(1).SubItems(20) = mm(38)
   Form64.ListView1.ListItems.Item(1).SubItems(21) = mm(39)
   Form64.ListView1.ListItems.Item(1).SubItems(22) = mm(70)
   Form64.ListView1.ListItems.Item(1).SubItems(23) = mm(74)
   Form64.ListView1.ListItems.Item(1).SubItems(24) = mm(40)
   
   Form64.ListView1.ListItems.Item(1).SubItems(25) = mm(75)
   Form64.ListView1.ListItems.Item(1).SubItems(26) = mm(76)
   Form64.ListView1.ListItems.Item(1).SubItems(27) = mm(41)
   


End If
mv1 = 0
mv2 = 0
        For l = 3 To 76
            mm(l) = 0
        Next
Form64.Frame2.Visible = True
End Sub

Private Sub Label10_Click()
Unload Me
End Sub

Private Sub Label2_Click()
Unload Me
End Sub

Private Sub Label3_Click()
Dim ghz As Integer
Dim zfm As String  'zfm变量用来获取用户输入的文件名
CommonDialog1.Filter = "MDB文件(*.mdb)|*.mdb|"
CommonDialog1.DialogTitle = "创建月统计数据的数据库"
CommonDialog1.ShowSave
CommonDialog1.InitDir = "c:\"
If CommonDialog1.FileName = "" Then
   MsgBox "你必须输入一个文件名，请重新保存一次！"
   Exit Sub
Else
   zfm = CommonDialog1.FileName
End If
zpstr = "Provider=Microsoft.Jet.OLEDB.4.0;"   '不能把这里的4.0改为3.51
zpstr = zpstr & "Data Source=" & zfm
zcat.Create zpstr  '创建数据库

 Dim tbl As New Table
 Dim m As Integer
   zstrTableName = "勘察经营人员统计数据"
   zcat.ActiveConnection = zpstr
   tbl.Name = zstrTableName   '表的名称
   tbl.Columns.Append "姓名", adVarWChar, 200     '表的第一个字段
   tbl.Columns.Append "工程编号", adVarWChar, 200    '表的第一个字段
   tbl.Columns.Append "工程名称", adVarWChar, 200   '表的第一个字段
   tbl.Columns.Append "建设单位", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "合同额", adVarWChar, 200     '表的第一个字段
   tbl.Columns.Append "进款额", adVarWChar, 200    '表的第一个字段
   tbl.Columns.Append "结算系数", adVarWChar, 200   '表的第一个字段
   tbl.Columns.Append "结算额", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "欠款", adVarWChar, 200     '表的第一个字段
   tbl.Columns.Append "结算员", adVarWChar, 200    '表的第一个字段
   tbl.Columns.Append "结算日期", adVarWChar, 200   '表的第一个字段
   tbl.Columns.Append "备注", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "合同额合计", adVarWChar, 200     '表的第一个字段
   tbl.Columns.Append "进款额合计", adVarWChar, 200    '表的第一个字段
   tbl.Columns.Append "结算额合计", adVarWChar, 200   '表的第一个字段
   tbl.Columns.Append "欠款额合计", adVarWChar, 200  '表的第一个字段
  zcat.Tables.Append tbl    '建立数据表'
  zconn.Open zpstr
  zrs.CursorLocation = adUseClient
  zrs.Open "select * from " & zstrTableName, zconn, adOpenKeyset, adLockPessimistic
 For m = 1 To Form64.ListView2.ListItems.Count
   With zrs
        .AddNew
        .Fields(0).Value = Form64.ListView2.ListItems.Item(m)
        For ghz = 1 To 15
            .Fields(ghz).Value = Form64.ListView2.ListItems.Item(m).SubItems(ghz)
        Next
  End With
    zrs.MoveNext
  Next
  zrs.Close
  zconn.Close
  
  Dim ln As Long
  ln = MsgBox("数据保存完毕！", vbInformation, "保存数据")
   
End Sub

Private Sub Label4_Click()
Unload Me
End Sub

Private Sub Label5_Click()
Dim ghz5, i, fk1, fk2, fk3, fk4, fk5, fk6  As Integer
Static j, a As Integer
Dim sum, s, sum1, sum2, sum3, sum4, sum5, sum6, sum7, sum8, sum9, sum10 As Single
Dim a1, a2, a3, a4, a5, a6, a7, a8, a9, fk11, fk12, fk13, fk14, fk15, fk16, fk17, fk18, fk19, ghz, ghz1, ghz2, ghz3, ghz4, SearchString, SearchChar, MyPos As String
Dim da1, da2, da3, da4 As Date
Dim mytab As New ADOX.Table
Form64.ListView2.ListItems.Clear
j = 0

hzrs.CursorLocation = adUseClient
hzrs.Open "select * from 经营人员结算单 order by ID", hzconn, adOpenKeyset, adLockPessimistic
   If mv3 = 0 Then
          MsgBox "请选择起始时间", vbInformation, "提示"
       hzrs.Close
       Exit Sub
   End If
   If mv4 = 0 Then
          MsgBox "请选择终止时间", vbInformation, "提示"
       hzrs.Close
       Exit Sub
   End If
   
For i = 1 To hzrs.RecordCount
    fk11 = hzrs.Fields(11).Value
    
If fk11 <> "0:00:00" Then
    fk1 = Len(fk11)
    fk12 = left(fk11, 4)
    fk13 = right(fk11, fk1 - 5)
    fk2 = Len(fk13)
    SearchString = fk13 ' 被搜索的字符串。
    SearchChar = "-"   ' 要查找字符串 "P"。
    MyPos = InStr(1, SearchString, SearchChar, 1)
    fk14 = left(fk13, MyPos - 1)
    fk15 = right(fk13, fk2 - MyPos)
    fk16 = fk12 & "-" & fk14 & "-" & fk15
    da1 = Format(fk11, "yyyy-mm-dd")
    da2 = Format(mvda3, "yyyy-mm-dd")
    da3 = Format(mvda4, "yyyy-mm-dd")
    If hzrs.Fields(1).Value = Combo1.Text Then
     If da1 >= da2 And da1 <= da3 Then
      j = j + 1
       sum = sum + hzrs.Fields(5).Value
       sum1 = sum1 + hzrs.Fields(6).Value
       sum2 = sum2 + hzrs.Fields(8).Value
       sum3 = sum3 + hzrs.Fields(9).Value
        Form64.ListView2.ListItems.Add j, , hzrs.Fields(1).Value
       For m = 2 To 12
        Form64.ListView2.ListItems.Item(j).SubItems(m - 1) = hzrs.Fields(m).Value
       Next
     End If
    End If
   End If
   hzrs.MoveNext
Next
hzrs.Close

Dim ln As Long
If j = 0 Then
  ln = MsgBox("没有要统计的数据！", vbInformation, "提示")
  Exit Sub
End If
If j <> 0 Then
  Form64.ListView2.ListItems.Item(j).SubItems(12) = sum
  Form64.ListView2.ListItems.Item(j).SubItems(13) = sum1
  Form64.ListView2.ListItems.Item(j).SubItems(14) = sum2
  Form64.ListView2.ListItems.Item(j).SubItems(15) = sum3
End If
mv3 = 0
mv4 = 0
Form64.Frame4.Visible = True
End Sub

Private Sub Label6_Click()
Unload Me
End Sub

Private Sub Label9_Click()
Dim ghz As Integer
Dim zfm As String  'zfm变量用来获取用户输入的文件名
CommonDialog1.Filter = "MDB文件(*.mdb)|*.mdb|"
CommonDialog1.DialogTitle = "创建月统计数据的数据库"
CommonDialog1.ShowSave
CommonDialog1.InitDir = "c:\"
If CommonDialog1.FileName = "" Then
   MsgBox "你必须输入一个文件名，请重新保存一次！"
   Exit Sub
Else
   zfm = CommonDialog1.FileName
End If
zpstr = "Provider=Microsoft.Jet.OLEDB.4.0;"   '不能把这里的4.0改为3.51
zpstr = zpstr & "Data Source=" & zfm
zcat.Create zpstr  '创建数据库

 Dim tbl As New Table
 Dim m As Integer
   zstrTableName = "勘察工程结算量统计数据"
   zcat.ActiveConnection = zpstr
   tbl.Name = zstrTableName   '表的名称
   tbl.Columns.Append "总进尺合计（米）", adVarWChar, 200     '表的第一个字段
   tbl.Columns.Append "钻探进尺合计（米）", adVarWChar, 200    '表的第一个字段
   tbl.Columns.Append "静力触探进尺合计（米）", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "合同额合计（元）", adVarWChar, 200   '表的第一个字段

   tbl.Columns.Append "下拨技术所≤25m工作量合计（米）", adVarWChar, 200     '表的第一个字段
   tbl.Columns.Append "下拨技术所≤25m小计合计（元）", adVarWChar, 200    '表的第一个字段
   tbl.Columns.Append "下拨技术所>25m工作量合计（米）", adVarWChar, 200   '表的第一个字段
   tbl.Columns.Append "下拨技术所>25m小计合计（元）", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "下拨技术所3小计合计（元）", adVarWChar, 200     '表的第一个字段
   tbl.Columns.Append "下拨技术所4小计合计（元）", adVarWChar, 200    '表的第一个字段
   tbl.Columns.Append "下拨技术所合计合计（元）", adVarWChar, 200  '表的第一个字段
   
   tbl.Columns.Append "下拨劳务所≤25m工作量合计（米）", adVarWChar, 200     '表的第一个字段
   tbl.Columns.Append "下拨劳务所≤25m小计合计（元）", adVarWChar, 200    '表的第一个字段
   tbl.Columns.Append "下拨劳务所>25m工作量合计（米）", adVarWChar, 200   '表的第一个字段
   tbl.Columns.Append "下拨劳务所>25m小计合计（元）", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "下拨劳务所3小计合计（元）", adVarWChar, 200     '表的第一个字段
   tbl.Columns.Append "下拨劳务所4小计合计（元）", adVarWChar, 200    '表的第一个字段
   tbl.Columns.Append "下拨劳务所合计合计（元）", adVarWChar, 200  '表的第一个字段
   
   tbl.Columns.Append "下拨土工试验室≤25m工作量合计（米）", adVarWChar, 200     '表的第一个字段
   tbl.Columns.Append "下拨土工试验室≤25m小计合计（元）", adVarWChar, 200    '表的第一个字段
   tbl.Columns.Append "下拨土工试验室>25m工作量合计（米）", adVarWChar, 200   '表的第一个字段
   tbl.Columns.Append "下拨土工试验室>25m小计合计（元）", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "下拨工试验室3小计合计（元）", adVarWChar, 200     '表的第一个字段
   tbl.Columns.Append "下拨工试验室4小计合计（元）", adVarWChar, 200    '表的第一个字段
   tbl.Columns.Append "下拨土木试验室合计合计（元）", adVarWChar, 200  '表的第一个字段
   
   tbl.Columns.Append "下拨合计累计（元）", adVarWChar, 200     '表的第一个字段
   tbl.Columns.Append "累计下拨合计（元）", adVarWChar, 200     '表的第一个字段
   tbl.Columns.Append "下拨其它合计（元）", adVarWChar, 200     '表的第一个字段
  zcat.Tables.Append tbl    '建立数据表'
  zconn.Open zpstr
  zrs.CursorLocation = adUseClient
  zrs.Open "select * from " & zstrTableName, zconn, adOpenKeyset, adLockPessimistic
 For m = 1 To Form64.ListView1.ListItems.Count
   With zrs
        .AddNew
        .Fields(0).Value = Form64.ListView1.ListItems.Item(m)
        For ghz = 1 To 27
            .Fields(ghz).Value = Form64.ListView1.ListItems.Item(m).SubItems(ghz)
        Next
  End With
    zrs.MoveNext
  Next
  zrs.Close
  zconn.Close
  
  Dim ln As Long
  ln = MsgBox("数据保存完毕！", vbInformation, "保存数据")
   
End Sub
Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
mv1 = mv1 + 1
If mv1 <> 0 Then
mvda1 = MonthView1.Value
End If
End Sub
Private Sub MonthView2_DateClick(ByVal DateClicked As Date)
mv2 = mv2 + 1
If mv2 <> 0 Then
mvda2 = MonthView2.Value
End If
End Sub
Private Sub MonthView3_DateClick(ByVal DateClicked As Date)
mv3 = mv3 + 1
If mv3 <> 0 Then
mvda3 = MonthView3.Value
End If
End Sub
Private Sub MonthView4_DateClick(ByVal DateClicked As Date)
mv4 = mv4 + 1
If mv4 <> 0 Then
mvda4 = MonthView4.Value
End If
End Sub