Last active
January 27, 2017 15:40
-
-
Save pudelosha/022b97117a3432e76ce9e9b6b775174a to your computer and use it in GitHub Desktop.
VBA ListView coding for fun
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Option Explicit | |
| Private strLVControlName As String | |
| Private WithEvents lv As ListView | |
| Private frm As UserForm | |
| Private strToOpenOnClick As String | |
| Private enItemClick As OnItemClick | |
| Private frmForm As UserForm | |
| Private Enum OnItemClick | |
| xlOpenSubForm = 1 | |
| xlEditItem = 2 | |
| End Enum | |
| Private Sub Class_Initialize() | |
| Set lv = New ListView | |
| enItemClick = xlOpenSubForm | |
| End Sub | |
| Private Sub Class_Terminate() | |
| Set lv = Nothing | |
| End Sub | |
| Property Let SetListViewName(strLVName As String) | |
| strLVControlName = strLVName | |
| End Property | |
| Property Let SetUserForm(frmUserForm As UserForm) | |
| Set frm = frmUserForm | |
| End Property | |
| Property Let SetRelatedUserForm(strFormName As String) | |
| strToOpenOnClick = strFormName | |
| End Property | |
| Sub ClearListView() | |
| lv.ColumnHeaders.Clear | |
| lv.ListItems.Clear | |
| End Sub | |
| Sub SetListView() | |
| If strLVControlName = "" Then | |
| MsgBox "The name of List View control was not provided." | |
| Exit Sub | |
| Else | |
| Set lv = frm.Controls(strLVControlName) | |
| With lv | |
| .View = lvwReport | |
| .FullRowSelect = True | |
| .Gridlines = True | |
| .LabelEdit = lvwManual | |
| .MultiSelect = False | |
| End With | |
| End If | |
| End Sub | |
| Sub FillListView(varRecordset As Variant, Optional blnDisplayHeaders As Boolean, Optional varHeaderDetails As Variant) | |
| Dim i As Integer | |
| Dim objListItem As ListItem | |
| Dim li As ListItem | |
| Dim j As Integer | |
| 'check if provided variable are arrays | |
| If Not IsArray(varRecordset) Then MsgBox "Variable varRecordset is not an array!": Exit Sub | |
| If Not IsMissing(varHeaderDetails) Then: If Not IsArray(varHeaderDetails) Then MsgBox "Variable varHeaderDetails is not an array!": Exit Sub | |
| 'check if LV object was assigned to variable | |
| If lv Is Nothing Then | |
| MsgBox "List View object was not set!" | |
| Exit Sub | |
| End If | |
| 'clear the list | |
| Me.ClearListView | |
| If blnDisplayHeaders Then | |
| For i = LBound(varHeaderDetails, 1) To UBound(varHeaderDetails, 1) | |
| lv.ColumnHeaders.Add Text:=varHeaderDetails(i, 0), Width:=varHeaderDetails(i, 1), Alignment:=lvwColumnLeft | |
| Next i | |
| With lv | |
| .HideColumnHeaders = Not blnDisplayHeaders | |
| For i = LBound(varRecordset, 1) To UBound(varRecordset, 1) | |
| Set objListItem = .ListItems.Add(Index:=i + 1, Text:=CStr(varRecordset(i, 0))) | |
| For j = 1 To UBound(varRecordset, 2) | |
| objListItem.SubItems(j) = CStr(varRecordset(i, j)) | |
| Next | |
| Next i | |
| End With | |
| Else | |
| lv.HideColumnHeaders = Not blnDisplayHeaders | |
| End If | |
| End Sub | |
| Sub ShowUserForm(strFormName As String) | |
| Dim objComponent | |
| For Each objComponent In Application.VBE.ActiveVBProject.VBComponents | |
| If StrComp(objComponent.Name, strFormName, vbTextCompare) = 0 And objComponent.Type = 3 Then | |
| VBA.UserForms.Add(strFormName).Show | |
| End If | |
| Next | |
| End Sub | |
| Private Sub lv_ItemClick(ByVal Item As MSComctlLib.ListItem) | |
| Select Case enItemClick | |
| Case 1 'Open SubForm | |
| Me.ShowUserForm "frmInitiativeDetails" | |
| Case 2 'Edit Item | |
| End Select | |
| End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment