form53.frm

办公自动化 vb+server2

     Form54.Text1(z).Enabled = True
   Next
   For z = 53 To 78
     Form54.Text1(z).Enabled = True
   Next
   Form54.Text1(43).Enabled = True
   Form54.Command1.Visible = True
   Form54.Command2.Visible = True
   Form54.Show vbModal
   Else
   MsgBox "不能修改该数据,没有领导批示或数据录入权属不同！", vbInformation, "提示"
      For p = 1 To Form53.ListView1.ListItems.Count
         Form53.ListView1.ListItems.Item(p).Checked = False
      Next
End If
   
End Sub

Private Sub Picture2_Click()
Dim i, j, m, n, p, k As Integer
Dim a As String
Dim c, MyPos As Integer
Dim c1, c2, c3, c4, c5, SearchString, SearchChar As String
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
m = 0
k = 0
For i = 1 To Form53.ListView1.ListItems.Count
  If Form53.ListView1.ListItems.Item(i).Checked = True Then
     m = m + 1
     normalstring(m) = Form53.ListView1.ListItems.Item(i)
  End If
Next
If m = 0 Then
   MsgBox "请选择要删除的数据！", vbInformation, "提示"
   Exit Sub
End If

Msg = "是否删除该数据"   ' 定义信息。
Style = vbYesNo + vbInformation + vbDefaultButton2   ' 定义按钮。
Title = "提示"   ' 定义标题。
Help = "DEMO.HLP"   ' 定义帮助文件。
Ctxt = 1000   ' 定义标题
      ' 上下文。
      ' 显示信息。
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then   ' 用户按下“是”。
'   MyString = "Yes"   ' 完成某操作。
    If m > 0 Then
        For j = 1 To m
            hzrs.CursorLocation = adUseClient
            hzrs.Open "select * from 勘察工程任务结算单", hzconn
             For i = 1 To hzrs.RecordCount
               If normalstring(j) = hzrs.Fields(1).Value And username = hzrs.Fields(42).Value Then   '总共125个字段
                    
                    If hzrs.Fields(44).Value = 0 And hzrs.Fields(46).Value = 0 Then
                       MyPos = 1
                    End If
                    If hzrs.Fields(44).Value <> 0 Or hzrs.Fields(46).Value <> 0 Then
                     c1 = hzrs.Fields(45).Value
                     c2 = hzrs.Fields(47).Value
                     c4 = c1 & c2
                     SearchString = c4 ' 被搜索的字符串。
                     SearchChar = "删"   ' 要查找字符串 "P"。
                     MyPos = InStr(1, SearchString, SearchChar, 1)
                    End If
                      If MyPos <> 0 Then
                              k = k + 1
                              hzrs.Delete
                      End If
               End If
              hzrs.MoveNext
             Next
            hzrs.Close
         Next
    End If
    If k = 1 Then
        MsgBox "删除完毕！", vbInformation, "提示"
         Unload Me
      Else
        MsgBox "不能删除该数据,没有领导批示或数据录入权属不同！", vbInformation, "提示"
            For p = 1 To Form53.ListView1.ListItems.Count
                Form53.ListView1.ListItems.Item(p).Checked = False
            Next
    End If
    
  Else   ' 用户按下“否”。
   MyString = "No"   ' 完成某操作。
    For p = 1 To Form53.ListView1.ListItems.Count
       Form53.ListView1.ListItems.Item(p).Checked = False
    Next
End If

End Sub

Private Sub Picture3_Click()
Dim f, MyPos, i, j, m, n, q, l, r, p, ghz, s, t As Integer
Dim a, b, c, d, e As String
Dim zfm, zstrTableName, zpstr, Msg, Style, Title, Help, Ctxt, Response, MyString, SearchString, SearchChar As String
 Dim tbl As New Table
'gfm变量用来获取用户输入的文件名
For s = 1 To Form53.ListView1.ListItems.Count
  If Form53.ListView1.ListItems.Item(s).Checked = True Then
     t = t + 1
  End If
Next
Msg = "是否想保存数据"   ' 定义信息。
Style = vbYesNo + vbInformation + vbDefaultButton2   ' 定义按钮。
Title = "提示"   ' 定义标题。
Help = "DEMO.HLP"   ' 定义帮助文件。
Ctxt = 1000   ' 定义标题
      ' 上下文。
      ' 显示信息。
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then   ' 用户按下“是”。
'   MyString = "Yes"   ' 完成某操作。
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  '创建数据库
   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 "结算工作量1", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "结算总价1", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "结算备注1", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "结算工作量2", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "结算总价2", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "结算备注2", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "结算类别3", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "结算孔深3", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "结算单位3", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "结算工作量3", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "结算总价3", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "结算备注3", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "结算类别4", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "结算孔深4", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "结算单位4", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "结算工作量4", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "结算总价4", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "结算备注4", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "合计", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "下拨工作量1", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "下拨小计1", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "下拨工作量11", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "下拨小计11", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "下拨合计1", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "下拨工作量2", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "下拨小计2", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "下拨工作量21", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "下拨小计21", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "下拨合计2", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "下拨工作量3", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "下拨小计3", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "下拨工作量31", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "下拨小计31", 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     '表的第一个字段
          tbl.Columns.Append "主管院长", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "主管院长备注", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "财务部", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "财务部备注", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "结算日期", adDate, 200    '表的第一个字段
          
          tbl.Columns.Append "技术所31", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "技术所32", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "技术所33", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "技术所34", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "技术所41", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "技术所42", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "技术所43", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "技术所44", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "劳务所31", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "劳务所32", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "劳务所33", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "劳务所34", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "劳务所41", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "劳务所42", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "劳务所43", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "劳务所44", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "土工试验室31", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "土工试验室32", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "土工试验室33", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "土工试验室34", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "土工试验室41", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "土工试验室42", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "土工试验室43", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "土工试验室44", 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 Form53.ListView1.ListItems.Count
      If Form53.ListView1.ListItems.Item(m).Checked = True Then
        hzrs.CursorLocation = adUseClient
        hzrs.Open "select * from 勘察工程任务结算单", hzconn, adOpenKeyset, adLockPessimistic
          For n = 1 To hzrs.RecordCount
             If hzrs.Fields(1).Value = Form53.ListView1.ListItems.Item(m) Then
               With zrs
                  .AddNew
                  .Fields(0).Value = hzrs.Fields(1).Value
                 For ghz = 1 To 78
                  .Fields(ghz).Value = hzrs.Fields(ghz + 1).Value
                 Next
               End With
            End If
          hzrs.MoveNext
       Next
     hzrs.Close
    End If
  Next
  zrs.Update
  zrs.Close
  zconn.Close
  MsgBox "数据保存完毕！", vbInformation, "提示"
Else   ' 用户按下“否”。
   MyString = "No"   ' 完成某操作。
   For p = 1 To Form53.ListView1.ListItems.Count
      Form53.ListView1.ListItems.Item(p).Checked = False
   Next
End If
Unload Me
End Sub

Private Sub Picture4_Click()
Unload Me
End Sub
Private Sub Picture5_Click()
Dim i, j, m, d As Integer
Static l As Integer
Dim a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40, a41, a42, a43, a44, a45, a46, a47, a48, a49, a50, a51, a52, a53, a54, a55, a56, a57, a58, a59, a60, a61, a62, a63, a64, a65, a66, a67, a68, a69, a70, a71, a72, a73, a74, a75, a76, a77, a78, a79, a80, a81, a82, a83, a84, a85, a86, a87, a88, a89, a90, a91, a92, a93, a94, a95, a96, a97, a98, a99, a100, a101, a102, a103, a104, a105, a106, a107, a108, a109, a110, a111, a112, a113, a114, a115, a116, a117, a118, a119, a120, a121, a122, a123, a124, a125, a126, a127, a128, a129, a130
For i = 1 To Form53.ListView1.ListItems.Count
  If Form53.ListView1.ListItems.Item(i).Checked = True Then
     m = m + 1
  End If
Next
If m <> 1 Then
   MsgBox "修改一条记录！", vbInformation, "提示"
   Exit Sub
End If

For i = 1 To Form53.ListView1.ListItems.Count
  If Form53.ListView1.ListItems.Item(i).Checked = True Then
    hzrs.CursorLocation = adUseClient
    hzrs.Open "select * from 勘察工程任务结算单", hzconn, adOpenKeyset, adLockPessimistic
      l = 0
      For j = 1 To hzrs.RecordCount
         If hzrs.Fields(1).Value = Form53.ListView1.ListItems.Item(i) Then
         
         For l = 1 To 6
          If hzrs.Fields(l).Value = 0 Then
             Form54.Text1(l).Text = ""
            Else
            Form54.Text1(l).Text = hzrs.Fields(l).Value
          End If
         Next
         For l = 26 To 50
          If hzrs.Fields(l).Value = 0 Then
             Form54.Text1(l).Text = ""
            Else
            Form54.Text1(l).Text = hzrs.Fields(l).Value
          End If
         Next
         For l = 51 To 79
          If hzrs.Fields(l).Value = 0 Then
             Form54.Text1(l + 2).Text = ""
            Else
            Form54.Text1(l + 2).Text = hzrs.Fields(l).Value
          End If
         Next
         
          Form54.Command2.Visible = True
          Form54.Command3.Visible = True
          Form54.Show vbModal
        End If
       hzrs.MoveNext
     Next
    hzrs.Close
 End If
Next
End Sub