|
Option Explicit
Private Const mc_OptWdth As Single = 12
Private Const mc_SbrWdth As Single = 15
Private mcol_WksToDelete As Collection
Private Sub UserForm_Initialize()
Dim rngSrc As Range
With Me.lstWksData1
.ColumnHeads = True
.ListStyle = fmListStyleOption
.MultiSelect = fmMultiSelectExtended
End With
With ThisWorkbook.Worksheets("ListBoxDemo1")
Set rngSrc = .Range(.Cells(1, 1), .Cells(8, 7))
End With
ShowWksData rngSrc, Me.lstWksData1, False
Set rngSrc = Nothing
With Me.lstWksData2
.ColumnHeads = True
End With
With ThisWorkbook.Worksheets("ListBoxDemo2")
Set rngSrc = Union(.Range(.Cells(5, 1), .Cells(5, 4)), _
.Range(.Cells(35, 1), .Cells(40, 4)))
End With
ShowWksData rngSrc, Me.lstWksData2
Set rngSrc = Nothing
End Sub
Private Sub ShowWksData(ByVal rngSrc As Range, ByVal lstListBox _
As MSForms.ListBox, Optional fSetColWidths As Boolean = True)
Dim nColsCnt As Long
Dim n As Long
Dim lngColWdth As Long
Dim strColWdths As String
nColsCnt = rngSrc.Columns.Count
If fSetColWidths = True Then
If lstListBox.ListStyle = fmListStyleOption Then
lngColWdth = _
(lstListBox.Width - mc_SbrWdth - mc_OptWdth) \ nColsCnt
Else
lngColWdth = (lstListBox.Width - mc_SbrWdth) \ nColsCnt
End If
For n = 1 To nColsCnt
strColWdths = strColWdths & lngColWdth & ";"
Next
strColWdths = VBA.Left(strColWdths, Len(strColWdths) - 1)
End If
With lstListBox
.ColumnCount = nColsCnt
If fSetColWidths = True Then
.ColumnWidths = strColWdths
End If
If rngSrc.Areas.Count > 1 Then
Dim objSheetA As Object
Dim wksNew As Worksheet
Set objSheetA = rngSrc.Parent.Parent.ActiveSheet
Application.ScreenUpdating = False
Set wksNew = rngSrc.Parent.Parent.Worksheets.Add
rngSrc.Copy
wksNew.Cells(1, 1).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
wksNew.Visible = xlSheetVeryHidden
Set rngSrc = wksNew.Cells(1, 1).CurrentRegion
If mcol_WksToDelete Is Nothing Then
Set mcol_WksToDelete = New Collection
End If
mcol_WksToDelete.Add wksNew, wksNew.Name
objSheetA.Activate
Set objSheetA = Nothing
Application.ScreenUpdating = True
End If
If (lstListBox.ColumnHeads = True) And _
(rngSrc.Rows.Count > 1) Then
.RowSource = rngSrc.Offset(1, 0).Resize( _
rngSrc.Rows.Count - 1).Address(External:=True)
Else
.RowSource = rngSrc.Address(External:=True)
End If
End With
End Sub
Private Sub UserForm_Terminate()
If Not mcol_WksToDelete Is Nothing Then
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim n As Long
For n = 1 To mcol_WksToDelete.Count
mcol_WksToDelete(1).Visible = xlSheetVisible
mcol_WksToDelete(1).Delete
mcol_WksToDelete.Remove 1
Next
Set mcol_WksToDelete = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End If
End Sub
|
|