|
|
楼主 |
发表于 2018-8-28 09:04
|
显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
本帖最后由 wxw7238 于 2018-8-28 09:22 编辑
望老师给予帮忙指导，具体修改那个代码呢？
'--------------- ququ 制作（QQ 273117802）-------------------
'可以手动调整窗体的高度和宽度
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 Const btrow As Integer = 1 '标题所在的行号(第几行),标题为单行;若标题行为第2行，则改为2。
Private Const coltotal As Integer = 9 '求和的列号(第几列),求和的结果显示在窗体下方的table1total。
Private Sub UserForm_Initialize()
Dim hwnd As Long
Dim lStyle As Long
Dim dic As Object
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 '将新的窗口样式指定给窗口
ComboBox1.List = Array("1列", "2列", "3列", "4列", "5列")
ComboBox1.Value = "3列"
With ActiveSheet
r = .UsedRange.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
c = .UsedRange.Find(what:="*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
arr = .Cells(btrow, 1).Resize(r - btrow + 1, c)
End With
For j = 1 To UBound(arr, 2)
Set labelx = Me.Frame9.Controls.Add("Forms.Label.1", "Labelx" & j)
labelx.Caption = arr(1, j)
labelx.TextAlign = fmTextAlignCenter
Set ComboBoxx = Me.Frame9.Controls.Add("Forms.combobox.1", "comboboxx" & j)
ComboBoxx.Font.Size = 12
ListView1.ColumnHeaders.Add , , arr(1, j)
If j > 1 Then
ListView1.ColumnHeaders(j).Alignment = lvwColumnCenter
End If
Next j
ListView1.View = lvwReport 'listivew的显示格式为报表格式
ListView1.Sorted = False 'listivew的排序属性为false
ListView1.Gridlines = True '显示网格线
ListView1.FullRowSelect = True '允许整行选中
For i = 2 To UBound(arr) '设置循环,填充记录
Set Itm = ListView1.ListItems.Add(, "行号" & i + btrow - 1, arr(i, 1))
For j = 2 To UBound(arr, 2)
Itm.SubItems(j - 1) = arr(i, j)
Next j
Next i
Label2.Caption = "共有 " & ListView1.ListItems.Count & " 条记录"
Me.Controls("comboboxx1").SetFocus
Call UserForm_Resize
Call sumcol
Call gengxinlist
End Sub
Private Sub UserForm_Resize() '调整窗体窗口及各控件的位置、大小。
On Error Resume Next
Dim btrr
With Label2
.Top = Me.Height - 30 - .Height
End With
With Label3
.Top = Label2.Top
.Caption = "ququ 制作"
.Left = Me.Width - 60
End With
With Label1total
.Top = Label2.Top
End With
Frame9.Width = Me.Width - 20
lieshu = Val(ComboBox1.Value)
Frame9.Height = Application.Min((Int((ListView1.ColumnHeaders.Count - 1) / lieshu) + 1) * 25 + 55, Me.Height / 3 * 2) '限制最大高度
ListView1.Top = Frame9.Top + Frame9.Height + 5
With ListView1
.Width = Me.Width - 20
.Height = Label2.Top - 6 - .Top
ReDim btrr(1 To .ColumnHeaders.Count)
For j = 1 To .ColumnHeaders.Count
btrr(j) = ActiveSheet.Columns(j).ColumnWidth
btsum = btsum + btrr(j)
Next j
For j = 1 To .ColumnHeaders.Count
.ColumnHeaders(j).Width = (.Width - 20) / btsum * btrr(j)
Next j
End With
For j = 1 To ListView1.ColumnHeaders.Count
x = (j - 1) Mod lieshu
y = Int((j - 1) / lieshu)
With Frame9.Controls("Labelx" & j)
.Left = Frame9.Width / lieshu * x + 5
.Top = 50 + 25 * y
.Width = 50
.Height = 20
End With
With Frame9.Controls("comboboxx" & j)
.Left = Frame9.Width / lieshu * x + 55
.Top = 45 + 25 * y
.Width = Frame9.Width / lieshu - 70
.Height = 20
End With
Next j
End Sub
Private Sub sumcol() '对指定列进行求和并在底部显示。
With ListView1
If coltotal <= .ColumnHeaders.Count Then
total = 0
For i = 1 To .ListItems.Count
If IsNumeric(.ListItems(i).SubItems(coltotal - 1)) Then
total = total + Val(.ListItems(i).SubItems(coltotal - 1))
End If
Next i
Label1total.Caption = .ColumnHeaders(coltotal).Text & "合计 " & total
Else
Label1total.Caption = ""
End If
End With
End Sub
Sub gengxinlist() '更新combobox.list
Dim d As Object
With ActiveSheet
r = .UsedRange.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
c = .UsedRange.Find(what:="*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
arr = .Cells(btrow, 1).Resize(r - btrow + 1, c)
End With
Set dic = CreateObject("scripting.dictionary")
For j = 1 To UBound(arr, 2)
For i = 2 To UBound(arr)
dic(arr(i, j)) = ""
Next i
brr = dic.keys
dic.RemoveAll
Me.Frame9.Controls("comboboxx" & j).List = brr
Next j
Set dic = Nothing
End Sub
Private Sub CommandButton1查询_Click() '查询
Dim st As String, stringsearch As String, stringpipei As String
Dim arr
ListView1.ListItems.Clear
For j = 1 To ListView1.ColumnHeaders.Count
st = Me.Controls("comboboxx" & j).Value
stringsearch = stringsearch & ",=" & IIf(st = "", "*", st)
Next
With ActiveSheet
r = .UsedRange.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
c = .UsedRange.Find(what:="*", searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
arr = .Cells(btrow, 1).Resize(r - btrow + 1, c)
For i = 2 To UBound(arr)
stringpipei = ""
For j = 1 To UBound(arr, 2)
stringpipei = stringpipei & ",=" & arr(i, j)
Next
If stringpipei Like stringsearch Then
Set Itm = ListView1.ListItems.Add(, "行号" & i + btrow - 1, arr(i, 1))
For j = 2 To UBound(arr, 2)
Itm.SubItems(j - 1) = arr(i, j)
Next j
End If
Next i
End With
Label2.Caption = "找到 " & ListView1.ListItems.Count & " 条记录"
Me.Controls("comboboxx1").SetFocus
Call sumcol
End Sub
Private Sub CommandButton6导出_Click()
Dim wb As Workbook
Dim arr As Variant, brr()
Application.SheetsInNewWorkbook = 1
On Error Resume Next
ReDim brr(1 To ListView1.ListItems.Count + 1, 1 To ListView1.ColumnHeaders.Count)
For j = 1 To UBound(brr)
brr(1, j) = ListView1.ColumnHeaders(j)
Next j
For i = 1 To ListView1.ListItems.Count
brr(i + 1, 1) = ListView1.ListItems(i)
For j = 2 To ListView1.ListItems(i).ListSubItems.Count + 1
brr(i + 1, j) = ListView1.ListItems(i).SubItems(j - 1)
Next j
Next i
Set wb = Workbooks.Add
With wb.Sheets(1)
.Range("a1").Resize(UBound(brr), UBound(brr, 2)) = brr
.UsedRange.Columns.AutoFit
.UsedRange.Borders.LineStyle = 1
pf = Application.GetSaveAsFilename(fileFilter:="Excel Files (*.xls), *.xls")
End With
If pf = False Then wb.Close False: Exit Sub
wb.SaveAs Filename:=pf, FileFormat:=xlWorkbookNormal
wb.Close True
End Sub
Private Sub ComboBox1_Change()
Call UserForm_Resize
End Sub
Private Sub ListView1_DblClick()
With Frame9
.comboboxx1.Text = ListView1.SelectedItem.Text
For j = 1 To ListView1.SelectedItem.ListSubItems.Count
.Controls("comboboxx" & j + 1).Text = ListView1.SelectedItem.ListSubItems(j)
Next
End With
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排序
ListView1.Sorted = False
myerr: ' 错误处理
Exit Sub
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2018-8-27 18:36
