form10.frm

办公自动化 vb+server2

      Top             =   7560
      Width           =   11175
   End
End
Attribute VB_Name = "Form10"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim normalstring(30) As String
Dim mm As Integer
Dim string1, string2 As String
Option Explicit
Dim rn As ADODB.Connection


Private Sub Command1_Click()

End Sub

Private Sub Form_Load()
   With Me
    .Height = 8010
    .left = 2332
    .top = 2600
    .Width = 12160
End With
End Sub



Private Sub Picture1_Click()
Dim i, m, j, n, k, p As Integer
If biaoming = "定线" Then
For i = 1 To Form10.ListView1.ListItems.Count
  If Form10.ListView1.ListItems.Item(i).Checked = True And Form10.ListView1.ListItems.Item(i).ListSubItems(19) = username Then
     m = m + 1
    Form11.Text1(0).Text = Form10.ListView1.ListItems.Item(i)
     For p = 1 To 14
         Form11.Text1(p).Text = Form10.ListView1.ListItems.Item(i).ListSubItems(p)
     Next
     Form11.Text1(15).Text = Form10.ListView1.ListItems.Item(i).ListSubItems(17)
     Form11.Text1(16).Text = Form10.ListView1.ListItems.Item(i).ListSubItems(18)
     Form11.Text1(17).Text = Form10.ListView1.ListItems.Item(i).ListSubItems(19)
  End If
Next
If m <> 1 Then
   MsgBox "本人修改或修改一条记录！", vbInformation, "提示"
   Exit Sub
   Else
   Form11.Show vbModal
End If
End If
If biaoming <> "定线" Then
For i = 1 To Form10.ListView1.ListItems.Count
  If Form10.ListView1.ListItems.Item(i).Checked = True And Form10.ListView1.ListItems.Item(i).ListSubItems(19) = username Then
     m = m + 1
    Form11.Text1(0).Text = Form10.ListView1.ListItems.Item(i)
     For p = 1 To 14
         Form11.Text1(p).Text = Form10.ListView1.ListItems.Item(i).ListSubItems(p)
     Next
     Form11.Text1(16).Text = Form10.ListView1.ListItems.Item(i).ListSubItems(18)
     Form11.Text1(17).Text = Form10.ListView1.ListItems.Item(i).ListSubItems(19)
  End If
Next
If m <> 1 Then
   MsgBox "本人修改或修改一条记录！", vbInformation, "提示"
   Exit Sub
   Else
   Form11.Show vbModal
End If
End If
End Sub

Private Sub Picture2_Click()
Dim i, j, m, n, p As Integer
Dim a As String
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
m = 0
For i = 1 To Form10.ListView1.ListItems.Count
  If Form10.ListView1.ListItems.Item(i).Checked = True And Form10.ListView1.ListItems.Item(i).ListSubItems(19) = username Then
     m = m + 1
     normalstring(m) = Form10.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
              rs.CursorLocation = adUseClient
              rs.Open biaoming, conn
            For i = 1 To rs.RecordCount
             If normalstring(j) = rs.Fields(0).Value Then
                    rs.Delete
              End If
            rs.MoveNext
            Next
            rs.Close
            Next
        End If
        MsgBox "删除完毕！", vbInformation, "提示"
        Unload Me
Else   ' 用户按下“否”。
   MyString = "No"   ' 完成某操作。
For p = 1 To Form10.ListView1.ListItems.Count
   Form10.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 Form10.ListView1.ListItems.Count
  If Form10.ListView1.ListItems.Item(s).Checked = True And Form10.ListView1.ListItems.Item(s).ListSubItems(19) = username Then
     t = t + 1
  End If
Next
If t = 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"   ' 完成某操作。
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  '创建数据库
If biaoming = "定线" Then
   zstrTableName = "统计数据"
   zcat.ActiveConnection = zpstr
    tbl.Name = zstrTableName   '表的名称
    tbl.Columns.Append "工程编号", adVarWChar, 180     '表的第一个字段
    tbl.Columns.Append "建设单位", adVarWChar, 180    '表的第一个字段
    tbl.Columns.Append "工程名称", adVarWChar, 180    '表的第一个字段
    tbl.Columns.Append "工程地点", adVarWChar, 180    '表的第一个字段
    tbl.Columns.Append "联系人及电话", adVarWChar, 180    '表的第一个字段
    tbl.Columns.Append "接受日期", adDate, 180    '表的第一个字段
    tbl.Columns.Append "下达日期", adDate, 180  '表的第一个字段
    tbl.Columns.Append "应交日期", adDate, 180  '表的第一个字段
    tbl.Columns.Append "实交日期", adDate, 180    '表的第一个字段
    tbl.Columns.Append "总工办接受日期", adDate, 180  '表的第一个字段
    tbl.Columns.Append "出图日期", adDate, 180  '表的第一个字段
    tbl.Columns.Append "予收额（元）", adCurrency, 180  '表的第一个字段
    tbl.Columns.Append "结算额（元）", adCurrency, 180  '表的第一个字段
    tbl.Columns.Append "实收额（元）", adCurrency, 180  '表的第一个字段
    tbl.Columns.Append "完成单位", adVarWChar, 180  '表的第一个字段
    tbl.Columns.Append "超期工程", adVarWChar, 180  '表的第一个字段
    tbl.Columns.Append "备注", adVarWChar, 180  '表的第一个字段
    tbl.Columns.Append "规划报件审批编号", adVarWChar, 180  '表的第一个字段
    tbl.Columns.Append "预收额备注", adVarWChar, 180  '表的第一个字段
    tbl.Columns.Append "登记人", adVarWChar, 180  '表的第一个字段
    
  zcat.Tables.Append tbl    '建立数据表'
  zconn.Open zpstr
  zrs.CursorLocation = adUseClient
  zrs.Open "select * from " & zstrTableName, zconn, adOpenKeyset, adLockPessimistic

 For m = 1 To Form10.ListView1.ListItems.Count
       If Form10.ListView1.ListItems.Item(m).Checked = True Then
         With zrs
          .AddNew
          .Fields(0).Value = Form10.ListView1.ListItems.Item(m)
           For ghz = 1 To 19
            .Fields(ghz).Value = Form10.ListView1.ListItems.Item(m).SubItems(ghz)
           Next
         End With
       End If
  Next
  zrs.Update
  zrs.Close
  zconn.Close
  MsgBox "数据保存完毕！", vbInformation, "提示"
End If

If biaoming <> "定线" Then
   zstrTableName = "统计数据"
   zcat.ActiveConnection = zpstr
    tbl.Name = zstrTableName   '表的名称
    tbl.Columns.Append "工程编号", adVarWChar, 180     '表的第一个字段
    tbl.Columns.Append "建设单位", adVarWChar, 180    '表的第一个字段
    tbl.Columns.Append "工程名称", adVarWChar, 180    '表的第一个字段
    tbl.Columns.Append "工程地点", adVarWChar, 180    '表的第一个字段
    tbl.Columns.Append "联系人及电话", adVarWChar, 180    '表的第一个字段
    tbl.Columns.Append "接受日期", adDate, 180    '表的第一个字段
    tbl.Columns.Append "下达日期", adDate, 180  '表的第一个字段
    tbl.Columns.Append "应交日期", adDate, 180  '表的第一个字段
    tbl.Columns.Append "实交日期", adDate, 180    '表的第一个字段
    tbl.Columns.Append "总工办接受日期", adDate, 180  '表的第一个字段
    tbl.Columns.Append "出图日期", adDate, 180  '表的第一个字段
    tbl.Columns.Append "予收额（元）", adCurrency, 180  '表的第一个字段
    tbl.Columns.Append "结算额（元）", adCurrency, 180  '表的第一个字段
    tbl.Columns.Append "实收额（元）", adCurrency, 180  '表的第一个字段
    tbl.Columns.Append "完成单位", adVarWChar, 180  '表的第一个字段
    tbl.Columns.Append "超期工程", adVarWChar, 180  '表的第一个字段
    tbl.Columns.Append "备注", adVarWChar, 180  '表的第一个字段
    tbl.Columns.Append "预收额备注", adVarWChar, 180  '表的第一个字段
    tbl.Columns.Append "登记人", adVarWChar, 180  '表的第一个字段
  zcat.Tables.Append tbl    '建立数据表'
  zconn.Open zpstr
  zrs.CursorLocation = adUseClient
  zrs.Open "select * from " & zstrTableName, zconn, adOpenKeyset, adLockPessimistic
 For m = 1 To Form10.ListView1.ListItems.Count
       If Form10.ListView1.ListItems.Item(m).Checked = True Then
         With zrs
          .AddNew
          .Fields(0).Value = Form10.ListView1.ListItems.Item(m)
           For ghz = 1 To 16
            .Fields(ghz).Value = Form10.ListView1.ListItems.Item(m).SubItems(ghz)
           Next
           .Fields(17).Value = Form10.ListView1.ListItems.Item(m).SubItems(18)
           .Fields(18).Value = Form10.ListView1.ListItems.Item(m).SubItems(19)
         End With
       End If
  Next
  zrs.Update
  zrs.Close
  zconn.Close
  MsgBox "数据保存完毕！", vbInformation, "提示"
End If




Else   ' 用户按下“否”。
   MyString = "No"   ' 完成某操作。
  
   For p = 1 To Form10.ListView1.ListItems.Count
      Form10.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()

End Sub