请帮我做一个窗体查询

xzgdsf

套用论坛一位老师的利用窗体模糊查询删除增加的例子，弄了一个晚上，怎么也做不成。谁能帮帮我。以前总在其它板块学习，现在看来要来这个版块好好学习了，从这个贴子开始，从头学起。请各位老师们帮我一下。 利用窗体增加修改删除及模糊查询监考表.zip (44.38 KB, 下载次数: 192)

2013-11-17 21:52 上传

点击文件名下载附件

pswxm

这个话题好，我也想学。请老师们帮助！

lzqmsy

做个记号,也是很想学的,哪位老师有时间给做下,谢谢!!!

xzgdsf

请哪位老师帮助一下，很多人都想学，很实用。

xzgdsf

翘首期盼，老师的帮助。

pswxm

把它捞起来，看有没有帮助。

pswxm

稍微懂一点，解决一点儿问题，抛砖引玉，期待高手。
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Private Const GWL_STYLE = (-16)
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_THICKFRAME = &H40000

Private Sub CommandButton2_Click()
  On Error Resume Next
Dim i As Integer
With Sheets("Sheet1")
i = .Range("a65536").End(xlUp).Row + 1
For j = 1 To 9
.Cells(i, j) = Controls("TB" & j).Text
Next
End With
MsgBox "记录添加成功!"
For j = 1 To 10
Controls("TB" & j).Text = ""
Next
End Sub
Private Sub CommandButton3_Click()
On Error Resume Next
Dim i As Integer
For j = 1 To 10
Controls("TB" & j).Text = ""
Next
End Sub

Private Sub CommandButton4_Click()
On Error Resume Next
Dim i As Integer
With Sheets("Sheet1")
i = Application.Match(TextBox1.Text, .Range("a:a"), 0)
For j = 1 To 9
.Cells(i, j) = Controls("TB" & j).Text
Next
End With
MsgBox "记录修改成功！"
End Sub

Private Sub CommandButton5_Click()
On Error Resume Next
Dim i As Integer
With Sheets("Sheet1")
i = Application.Match(TB1.Text, .Range("a:a"), 0)
.Rows(i).Delete
End With
MsgBox "记录删除成功！"
End Sub

Private Sub Frame9_Click()

End Sub

Private Sub Label12_Click()

End Sub

Private Sub Label7_Click()

End Sub

Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
    With Frame9
        .TB1.Text = Item.Text
        .TB2.Text = Item.ListSubItems(1)
        .TB3.Text = Item.ListSubItems(2)
        .TB4.Text = Item.ListSubItems(3)
        .TB5.Text = Item.ListSubItems(4)
      
    End With
End Sub
Private Sub 导出数据_Click()
Dim Nowbook As Workbook
    Dim ShName As Variant
    Dim Arr As Variant
    Dim i As Integer
    Dim myNewWorkbook As Integer
    myNewWorkbook = Application.SheetsInNewWorkbook
    ShName = Array("日期")
    Arr = Array("日期", "时间", "场次", "考试班级", "监考人员1", "地点1", "监考人员2", "地点2", "科目")
    Application.SheetsInNewWorkbook = 1
    Set Nowbook = Workbooks.Add
    With Nowbook
            With .Sheets(1)
                .Name = ShName(0)
                .Range("a1").Resize(1, UBound(Arr) + 1) = Arr
            End With
    End With
    Set Nowbook = Nothing
   Application.SheetsInNewWorkbook = myNewWorkbook
   '**************************************************************
   On Error Resume Next
   Dim j As Integer, K As Integer, z As Integer
   With Application.Sheets("日期")
              .Activate
              .Visible = True
   For j = 1 To ListView1.ListItems.Count
           K = .Range("A65536").End(xlUp).Row
           .Cells(K + 1, 1) = ListView1.ListItems(j)
       For z = 2 To 5
                .Cells(K + 1, z) = ListView1.ListItems(j).SubItems(z - 1)
       Next z
   Next j
   Do
       fName = Application.GetSaveAsFilename(fileFilter:="Excel Files (*.xls), *.xls")
   Loop Until fName <> False
       Sheets("日期").SaveAs Filename:=fName
  End With
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
   On Error GoTo myerr    ' 错误处理
    ListView1.SortKey = ColumnHeader.Index - 1   ' 设定排序值的索引，sortkey是从0开始的，所以要减1
    If ListView1.SortOrder = lvwDescending Then   ' 当前是否为降序
        ListView1.SortOrder = lvwAscending       ' 按升序
    Else
        ListView1.SortOrder = lvwDescending      ' 按降序
    End If
    ListView1.Sorted = True                      ' 激活listview排序
myerr:      ' 错误处理
    Exit Sub
End Sub

Private Sub TextBox1_Change()
Dim what As String: what = TextBox1.Value
Dim rw As String: rw = Sheet1.Range("A65536").End(xlUp).Row
Dim total As String
total = 0

If TextBox1.Value = "" Then
    '   如果文本框内容为空,导入所有数据
    ListView1.ListItems.Clear
        With Sheet1
          For i = 2 To rw
            Set ITM = ListView1.ListItems.Add()
            ITM.Text = .Cells(i, 1)
            ITM.SubItems(1) = .Cells(i, 2)
            ITM.SubItems(2) = .Cells(i, 3)
            'ITM.SubItems(3) = Format(.Cells(i, 4), "#,##0")
            ITM.SubItems(3) = Sheet1.Cells(i, 4)
            ITM.SubItems(4) = Sheet1.Cells(i, 5)
                total = total + .Cells(i, 5).Value
            Next i
        End With
            Label2.Caption = "共找到 " & ListView1.ListItems.Count & " 条记录"
           ' Label3.Caption = "总计: " & Format(total, "#,##0")
            TextBox1.SetFocus
    Exit Sub

Else

    Dim rng As Range
    Set rng = Sheet1.Range("A2:C" & rw)     '   关键字所在的区域
    Dim dic As Object
    Set dic = CreateObject("scripting.dictionary")
    ListView1.ListItems.Clear   '   清除所有内容
    For i = 2 To rw
        For ii = 1 To 3
            Dim tmp As Range
            Set tmp = Sheet1.Cells(i, ii).Find(what, lookat:=xlPart, MatchCase:=False)      '   部分匹配, 不区分大小写
                If Not tmp Is Nothing Then
                    If Not dic.exists(tmp.Row) Then     '   因为是一行多列查找,所以只要有一个单元格符合要求,要需要换行,否则listitem数据重复
                        dic.Add tmp.Row, ""
                        Set ITM = ListView1.ListItems.Add()
                        ITM.Text = Sheet1.Cells(i, 1)
                        ITM.SubItems(1) = Sheet1.Cells(i, 2)
                        ITM.SubItems(2) = Sheet1.Cells(i, 3)
                       ITM.SubItems(3) = Sheet1.Cells(i, 4)
                       ITM.SubItems(4) = Sheet1.Cells(i, 5)
                            total = total + Sheet1.Cells(i, 5).Value
                    End If
                End If
            Next ii
        Next i
        Label2.Caption = "共找到 " & ListView1.ListItems.Count & " 条记录"
        Set dic = Nothing
End If

End Sub

Private Sub UserForm_Initialize()


Dim hwnd As Long
Dim lStyle As Long
hwnd = FindWindow("ThunderDFrame", Me.Caption) '找到窗口的句柄
lStyle = GetWindowLong(hwnd, GWL_STYLE) '获得窗口的样式
lStyle = lStyle Or WS_MINIMIZEBOX       '在原窗口样式增加最小化按钮
lStyle = lStyle Or WS_MAXIMIZEBOX       '进一步增加最大化按钮
lStyle = lStyle Or WS_THICKFRAME        '进一步增加窗口边框，使得窗口可以通过鼠标拖拉改变大小
SetWindowLong hwnd, GWL_STYLE, lStyle    '将新的窗口样式指定给窗口


  ListView1.ColumnHeaders.Add , , "日期", Width / 3.5
  ListView1.ColumnHeaders.Add , , "时间", Width / 4
  ListView1.ColumnHeaders.Add , , "场次", Width / 6, lvwColumnCenter
  ListView1.ColumnHeaders.Add , , "考试班级", Width / 9, lvwColumnCenter
  ListView1.ColumnHeaders.Add , , "监考人员1", Width / 9, lvwColumnCenter
  ListView1.View = lvwReport        '   listivew的显示格式为报表格式
  ListView1.Sorted = True           '   listivew的排序属性为true
  ListView1.SortKey = 0         '   listivew排序的索引为 '收款单位', 从 0 开始
  ListView1.Gridlines = True        '   显示网格线
  ListView1.FullRowSelect = True    '   允许整行选中
  Label2.Caption = ""
  Label3.Caption = ""
  
  '设置循环,填充记录
  Dim rw As String
  rw = Sheet1.Range("A65536").End(xlUp).Row
  Dim total As String
  total = 0
With Sheet1
  For i = 2 To rw
    Set ITM = ListView1.ListItems.Add()
    ITM.Text = .Cells(i, 1)
    ITM.SubItems(1) = .Cells(i, 2)
    ITM.SubItems(2) = .Cells(i, 3)
    ITM.SubItems(3) = .Cells(i, 4)
    ITM.SubItems(4) = .Cells(i, 5)
        total = total + .Cells(i, 5).Value
    Next i
End With
    Label2.Caption = "共找到 " & ListView1.ListItems.Count & " 条记录"
    TextBox1.SetFocus
End Sub
Private Sub ListView1_DblClick()
    With ActiveSheet
        .Cells(Selection.Row, Selection.Column).Offset(0, 0) = ListView1.SelectedItem.Text
        .Cells(Selection.Row, Selection.Column).Offset(0, 1) = ListView1.SelectedItem.SubItems(1)
        .Cells(Selection.Row, Selection.Column).Offset(0, 2) = ListView1.SelectedItem.SubItems(2)
        .Cells(Selection.Row, Selection.Column).Offset(0, 3) = ListView1.SelectedItem.SubItems(3)
        .Cells(Selection.Row, Selection.Column).Offset(0, 4) = ListView1.SelectedItem.SubItems(4)
        End With
        Unload Me
End Sub
Private Sub UserForm_Resize()
    On Error Resume Next
    With Label2
        .Top = Me.Height - 30 - .Height
    End With
    Label3.Top = Label2.Top
    With ListView1
        .Width = Me.Width - 12
        .Height = Label2.Top - 6 - .Top
        .ColumnHeaders(1).Width = .Width / 3.5
        .ColumnHeaders(2).Width = .Width / 4
        .ColumnHeaders(3).Width = .Width / 6
        .ColumnHeaders(4).Width = .Width / 9
        .ColumnHeaders(5).Width = .Width / 9
    End With
End Sub

tengwp

学习中，只是修改了窗口，按钮控件学习中，感谢楼上的

xzgdsf

感谢前面三位老师的帮助，已经前进了很多，我感觉离目标很近了。窗口做好了，把功能再加上去就可以了。哪位老师再帮一把。谢谢！

pswxm

还在热切盼望中。