So I've been following the discussions around VBA as an OOP language and the applicability of various design patterns, such as MVP or MVC. Excellent postings on these topics are extremely informative and have caused me to rethink my implementation approach for my projects (past and present). Change and growth is always a good thing :)
- What are MVP and MVC and what is the difference?
- UserForm1.Show
- Responding to Events of Dynamically added Controls
- VBA+OOP: What, When, and Why
- plus many of the posts here on Code Review (especially the Battleship implementation)
What I'm looking for is a discussion along these lines on the applicability of the MVC/MVP design pattern when then the "view" is not a userform, but is the worksheet itself. I think this is a common implementation technique for many developers, both new and experienced. This especially includes worksheets that hold the data to be manipulated and use embedded form controls. I'll contribute an example of my own approach to add to the discussion for critique and comment.
Design Thoughts
Most of the clean examples discussed about an MVP or MVC design pattern present the user interface as a userform. The userform is an easily accessible object with the class VBA code written largely by the developer. Controls are added, often WithEvents, and Interface classes can be designed for the userform to Implement. The data presented and/or used on the userform most often is derived or directly sourced from data on a worksheet. But what if the worksheet IS both the datastore and the "view with controls"?
I toyed with creating a persistent object that would be always available (VB_PredeclaredId = True), but discarded that idea because there already is a persistent data store: the worksheet object itself. The basic idea is an MVC design pattern.
After many different iterations, I arrived at a design where a data model is created only when needed, i.e. when activity on the worksheet occurs. The "view" aspect of the pattern is handled directly by the formatted data on the worksheet. The "controller" part of the pattern are functional Sub and Function calls tied directly to worksheet or control events.
(The whole reason for this post and my interest in a discussion is to find out if this is a "preferred" way of achieving the goals of the application. Clearly, my approach works. But I'm always on a quest for improvement!)
The Application
This is one part of an overall application that's needed to import a variety of data from external sources. The original configuration interface was set up on a worksheet with a (relatively) static number of possible entries. Each entry row is selectable and the user can click a button to bring up the file selection dialog to choose a file. Two of the fields are user-editable. (Optional access to this application in my GitHub)
If you choose, there is a module below (CreateProjectSheet) that should create the "Configure" worksheet, format the "view" and create the controls. Obviously, run the top-level routine once to set up the worksheet.
The Code - ConfigureView Project
The code breaks down into a combination of the data model (ProjectsModel with a ProjectInfo collection) and the "controller" code (several code modules that respond to the worksheet and control events.
Starting in the ProjectGlobal module, there is a set of helper functions that give quick access to relevant areas of the "view". Additionally, I've established an enumeration that provides access to the correct data column within the "view".
Module: ProjectGlobal
Option Explicit
Public Enum ProjectInfoColumns
[_First] = 1 'columns numbers are relative to the anchor cell
ProjectNumber = 1
SelectCheckBox = 2
DBName = 3
FullPath = 4
BrowseButton = 5
FileTimestamp = 6
SelectedCellLink = 7
[_Last] = 7
End Enum
Public Enum ProjectApp_Errors
NoProjectArea = vbObject + 600
IndexOutOfBounds
End Enum
Public Const DEFAULT_PROJECT_ROWS As Long = 15
Public Const ROW_ONE_ANCHOR As String = "A3"
Public Function ConnectToModel() As ProjectsModel
Dim anchor As Range
Dim projectArea As Range
Set anchor = ThisWorkbook.Sheets("Configure").Range(ROW_ONE_ANCHOR)
Set projectArea = anchor.Resize(DEFAULT_PROJECT_ROWS, ProjectInfoColumns.[_Last])
Dim pvm As ProjectsModel
Set pvm = New ProjectsModel
pvm.Connect projectArea
Set ConnectToModel = pvm
End Function
Public Function ProjectEditableArea() As Range
Dim anchor As Range
Dim projectArea As Range
Set anchor = ThisWorkbook.Sheets("Configure").Range(ROW_ONE_ANCHOR)
Set projectArea = anchor.Resize(DEFAULT_PROJECT_ROWS, ProjectInfoColumns.[_Last])
Set ProjectEditableArea = Application.Union(projectArea.Columns(ProjectInfoColumns.DBName), _
projectArea.Columns(ProjectInfoColumns.FullPath))
End Function
Public Function ProjectSelectAllCell() As Range
Dim anchor As Range
Set anchor = ThisWorkbook.Sheets("Configure").Range(ROW_ONE_ANCHOR)
Set ProjectSelectAllCell = anchor.Offset(-1, ProjectInfoColumns.SelectedCellLink - 1)
End Function
Public Function ProjectInfoColumnsName(ByVal index As Long) As String
ProjectInfoColumnsName = vbNullString
If (index >= ProjectInfoColumns.[_First]) Or _
(index <= ProjectInfoColumns.[_Last]) Then
Dim names() As String
names = Split(",Name in DB,MS Excel Path,," & _
"MS Excel File Timestamp,,", _
",", , vbTextCompare)
ProjectInfoColumnsName = names(index - 1)
End If
End Function
Public Function ProjectRowIndex(ByVal wsRowIndex As Long) As Long
'--- given the worksheet row number, this returns the project
' index row into the group of projects
Dim anchor As Range
Set anchor = ThisWorkbook.Sheets("Configure").Range(ROW_ONE_ANCHOR)
ProjectRowIndex = wsRowIndex - anchor.Row + 1
End Function
In particular, notice the ConnectToModel function that creates the data model giving quick and abstracted access to the underlying data. All data access should go through this model.
Class: ProjectsModel
Option Explicit
Private Type InternalData
storage As Range
projects As Collection 'collection of ProjectInfo objects
End Type
Private this As InternalData
Public Property Get IsConnected() As Boolean
IsConnected = (Not this.projects Is Nothing)
End Property
Public Property Get ProjectCount() As Long
If Not this.projects Is Nothing Then
ProjectCount = this.projects.Count
Else
ProjectCount = 0
End If
End Property
Public Property Get GetProject(ByVal index As Long) As ProjectInfo
If Not this.projects Is Nothing Then
If index > 0 And index <= this.projects.Count Then
Set GetProject = this.projects(index)
Else
Err.Raise ProjectApp_Errors.IndexOutOfBounds, _
"ProjectsModel::GetProject", _
"Project index out of bounds"
End If
Else
Set GetProject = Nothing
End If
End Property
Public Sub Connect(ByRef projectArea As Range)
If this.storage Is Nothing Then
If Not projectArea Is Nothing Then
Set this.storage = projectArea
Else
Err.Raise ProjectApp_Errors.NoProjectArea, _
"ProjectsModel::Load", _
"Missing project area"
End If
ElseIf Not this.storage = projectArea Then
'--- we've got a new table, so dump the old one and reload
Set this.storage = Nothing
Set this.storage = projectArea
End If
Set this.projects = Nothing
Set this.projects = New Collection
Dim projectRow As Range
Set projectRow = this.storage.Resize(1, ProjectInfoColumns.[_Last])
Dim i As Long
Dim newInfo As ProjectInfo
For i = 1 To projectArea.Rows.Count
Set newInfo = New ProjectInfo
newInfo.Connect projectRow
this.projects.Add newInfo
Set projectRow = projectRow.Offset(1, 0)
Next i
End Sub
Public Function GetSelectedProjects() As Collection
Dim selectedCollection As Collection
Dim projectRow As Variant
For Each projectRow In this.projects
If projectRow.IsSelected Then
If selectedCollection Is Nothing Then
Set selectedCollection = New Collection
End If
selectedCollection.Add projectRow
End If
Next projectRow
Set GetSelectedProjects = selectedCollection
End Function
Private Sub Class_Initialize()
End Sub
There's an interesting aspect to the ProjectInfo class below. Because each "view" row has a checkbox (and a button), expected UX behavior would present the checkbox as "unselectable" if the row is empty of data. So each of the ProjectInfo objects must "connect" to the appropriate checkbox located on its row, and then enable/disable as appropriate.
Class: ProjectInfo
Option Explicit
Private Type InternalData
projectRow As Range
selectBox As CheckBox
End Type
Private this As InternalData
Public Property Let IsSelected(ByVal newState As Boolean)
'--- can only be selected if there is a valid filename
If Len(this.projectRow.Cells(1, ProjectInfoColumns.FullPath)) > 0 Then
this.projectRow.Cells(1, ProjectInfoColumns.SelectedCellLink).Value = newState
End If
End Property
Public Property Get IsSelected() As Boolean
IsSelected = this.projectRow.Cells(1, ProjectInfoColumns.SelectedCellLink).Value
End Property
Public Property Let NameInDB(ByVal newName As String)
'--- disable events because this area is watched by a
' Worksheet_Change event
Application.EnableEvents = False
this.projectRow.Cells(1, ProjectInfoColumns.DBName).Value = newName
Application.EnableEvents = True
End Property
Public Property Get NameInDB() As String
NameInDB = this.projectRow.Cells(1, ProjectInfoColumns.DBName).Value
End Property
Public Property Let FullPath(ByVal newPath As String)
'--- disable events because this area is watched by a
' Worksheet_Change event
Application.EnableEvents = False
If Len(newPath) > 0 Then
this.projectRow.Cells(1, ProjectInfoColumns.FullPath).Value = newPath
On Error GoTo TimestampError
Me.FileTimestamp = FileDateTime(newPath)
Else
'--- clear all the data if the user deleted the name
this.projectRow.Cells(1, ProjectInfoColumns.DBName).Value = vbNullString
this.projectRow.Cells(1, ProjectInfoColumns.FullPath).Value = vbNullString
this.projectRow.Cells(1, ProjectInfoColumns.FileTimestamp).Value = vbNullString
End If
NormalExit:
SetCheckBoxState
Application.EnableEvents = True
Exit Property
TimestampError:
If Err.Number = 53 Then
MsgBox "The filename you entered is not valid. Please enter " & _
"a valid filename.", vbCritical + vbOKOnly, _
"Error In Filename"
this.projectRow.Cells(1, ProjectInfoColumns.FullPath).Value = vbNullString
End If
GoTo NormalExit
End Property
Public Property Get FullPath() As String
FullPath = this.projectRow.Cells(1, ProjectInfoColumns.FullPath)
End Property
Public Property Get PathOnly() As String
'--- returns ONLY the path part of the full path
PathOnly = vbNullString
If Len(Me.FullPath) = 0 Then
Exit Property
End If
Dim pos1 As Long
pos1 = InStrRev(Me.FullPath, "\", , vbTextCompare)
If pos1 > 0 Then
PathOnly = left$(Me.FullPath, pos1 - 1)
Else
PathOnly = Me.FullPath
End If
End Property
Public Property Get Filename() As String
'--- returns ONLY the filename part of the full path
Filename = vbNullString
If Len(Me.FullPath) = 0 Then
Exit Property
End If
Dim pos1 As Long
pos1 = InStrRev(Me.FullPath, "\", , vbTextCompare)
If pos1 > 0 Then
Filename = Right$(Me.FullPath, Len(Me.FullPath) - pos1)
Else
Filename = Me.FullPath
End If
End Property
Public Property Let FileTimestamp(ByVal newDate As Date)
this.projectRow.Cells(1, ProjectInfoColumns.FileTimestamp).Value = newDate
End Property
Public Property Get FileTimestamp() As Date
FileTimestamp = this.projectRow.Cells(1, ProjectInfoColumns.FileTimestamp).Value
End Property
Public Sub Connect(ByRef dataRow As Range)
'--- establishes the connection of this object to the given worksheet
' row of project data
Set this.projectRow = dataRow
FindMyCheckBox
SetCheckBoxState
End Sub
Private Sub Class_Initialize()
End Sub
Private Sub FindMyCheckBox()
'--- quickly loop through all the checkboxes on the worksheet and find the
' one that is located in this assigned row. there can only be one
Dim cb As CheckBox
Dim ws As Worksheet
Set ws = this.projectRow.Parent
For Each cb In ws.CheckBoxes
If (cb.top >= this.projectRow.top) And _
(cb.top < (this.projectRow.top + this.projectRow.height)) Then
Set this.selectBox = cb
Exit For
End If
Next cb
End Sub
Private Sub SetCheckBoxState()
'--- the checkbox is enabled if there is a valid filename
If Not this.selectBox Is Nothing Then
If Len(Me.FullPath) > 0 Then
this.selectBox.Enabled = True
Else
this.selectBox.Value = False
this.selectBox.Enabled = False
End If
End If
End Sub
So executing the ConnectToModel function will create the model above.
Start interacting with the "view" by clicking any of the file browse buttons and choosing a file. The file path and timestamp are filled in. The "Name in DB" is optional and less important in this example. You can also manually enter a filename if you choose which will be picked up by the Worksheet_Change event in the worksheet object.
Module: ProjectBrowse
Option Explicit
Public Sub UserFileSelect()
'--- connected to the "..." button on the Configure worksheet to select
' an MS Project file for that row
Dim wsRow As Long
Dim projectIndex As Long
wsRow = ThisWorkbook.Sheets("Configure").Shapes(Application.Caller).TopLeftCell.Row
projectIndex = ProjectRowIndex(wsRow)
Dim pvm As ProjectsModel
Set pvm = ConnectToModel()
Dim projInfo As ProjectInfo
Set projInfo = pvm.GetProject(projectIndex)
Dim filePicker As Office.FileDialog
Set filePicker = Application.FileDialog(MsoFileDialogType.msoFileDialogOpen)
With filePicker
.Title = "Select an MS Excel File to Add..."
.Filters.Add "MS Project", "*.xlsx", 1
.AllowMultiSelect = False
If Len(projInfo.FullPath) > 0 Then
.InitialFileName = projInfo.FullPath
Else
.InitialFileName = ThisWorkbook.path
End If
If .Show Then
projInfo.FullPath = .SelectedItems(1)
End If
End With
End Sub
Worksheet Object: `Sheet2 (Configure)
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim editArea As Range
Dim dbNameArea As Range
Dim selectAllBox As Range
Set editArea = ProjectGlobal.ProjectEditableArea().Columns(2)
Set dbNameArea = ProjectGlobal.ProjectEditableArea().Columns(1)
Set selectAllBox = ProjectGlobal.ProjectSelectAllCell()
Dim i As Long
Dim pvm As ProjectsModel
Dim projectIndex As Long
Dim projInfo As ProjectInfo
If Not Union(editArea, Target) Is Nothing Then
Set pvm = ProjectGlobal.ConnectToModel()
For i = 1 To Target.Rows.Count
projectIndex = ProjectGlobal.ProjectRowIndex(Target.Rows(i).Row)
Set projInfo = pvm.GetProject(projectIndex)
'--- this was just edited by the user, but re-apply the edit
' through the Info object for validation
projInfo.FullPath = Target.Rows(i).Value
Next i
ElseIf Not Union(dbNameArea, Target) Is Nothing Then
Set pvm = ProjectGlobal.ConnectToModel()
For i = 1 To Target.Rows.Count
projectIndex = ProjectGlobal.ProjectRowIndex(Target.Rows(i).Row)
Set projInfo = pvm.GetProject(projectIndex)
'--- this was just edited by the user, but re-apply the edit
' through the Info object for validation
projInfo.NameInDB = Target.Rows(i).Value
Next i
ElseIf Not Union(selectAllBox, Target) Then
ProjectSelect.CheckUncheckAll
End If
End Sub
The other "view" controls are the checkboxes and the "Import" button. The code for those is below:
Module: ProjectSelect
Option Explicit
Public Sub CheckUncheckAll()
Dim selectAllBox As Range
Set selectAllBox = ProjectSelectAllCell()
Dim pvm As ProjectsModel
Dim projInfo As ProjectInfo
Set pvm = ConnectToModel()
Dim i As Long
For i = 1 To pvm.ProjectCount
Set projInfo = pvm.GetProject(i)
projInfo.IsSelected = selectAllBox
Next i
End Sub
Module: ProjectImport
Option Explicit
Public Sub ImportProjects()
Dim pvm As ProjectsModel
Set pvm = ConnectToModel()
Dim selectedProjects As Collection
Set selectedProjects = pvm.GetSelectedProjects
Dim text As String
If selectedProjects Is Nothing Then
text = "No projects selected!"
Else
Dim proj As Variant
For Each proj In selectedProjects
text = text & " -- " & proj.Filename & vbCrLf
Next proj
End If
MsgBox "You selected these projects for import:" & vbCrLf & text, _
vbInformation + vbOKOnly
End Sub
As promised, if you wanted to create and interact with this application, import the module below and execute BuildProjectView
Module: CreateProjectsSheet
Option Explicit
Public Sub BuildProjectView()
'--- wipe the sheet and build it up to ensure everything is
' in the right place
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Sheets("Configure")
If ws Is Nothing Then
Set ws = ThisWorkbook.Sheets.Add
ws.Name = "Configure"
End If
ResetSheet ws
Dim anchor As Range
Dim projectArea As Range
Dim headerArea As Range
Dim importArea As Range
Set anchor = ws.Range(ROW_ONE_ANCHOR)
Set projectArea = anchor.Resize(DEFAULT_PROJECT_ROWS, ProjectInfoColumns.[_Last])
Set headerArea = anchor.Offset(-1, 1).Resize(1, ProjectInfoColumns.[_Last] - 2)
Set importArea = anchor.Offset(DEFAULT_PROJECT_ROWS + 1, 2)
ws.Cells.Interior.color = XlRgbColor.rgbPaleTurquoise 'overall bg color
FormatProjectArea projectArea, headerArea
CreateBrowseButtons ws, projectArea
CreateCheckboxes ws, projectArea
CreateImportButton ws, importArea
anchor.Offset(, 2).Select
End Sub
Private Sub ResetSheet(ByRef ws As Worksheet)
With ws
.Cells.Clear
.Cells.ColumnWidth = 8.14
.Cells.EntireRow.AutoFit
.Cells.Font.Name = "Calibri"
.Cells.Font.Size = 11
Do While .CheckBoxes.Count > 0
.CheckBoxes(1).Delete
Loop
Do While .Buttons.Count > 0
.Buttons(1).Delete
Loop
Do While .OLEObjects.Count > 0
.OLEObjects(1).Delete
Loop
End With
End Sub
Private Sub FormatProjectArea(ByRef projectArea As Range, _
ByRef headerArea As Range)
Dim areaWithoutNumbers As Range
Set areaWithoutNumbers = projectArea.Offset(0, 1).Resize(, ProjectInfoColumns.[_Last] - 2)
With areaWithoutNumbers.Borders
.LineStyle = xlContinuous
.color = XlRgbColor.rgbDarkGray
.Weight = xlThin
End With
'--- predefined column widths and formats
With projectArea
.Columns(ProjectInfoColumns.ProjectNumber).ColumnWidth = 3#
.Columns(ProjectInfoColumns.SelectCheckBox).ColumnWidth = 3#
.Columns(ProjectInfoColumns.DBName).ColumnWidth = 11#
.Columns(ProjectInfoColumns.FullPath).ColumnWidth = 40#
.Columns(ProjectInfoColumns.BrowseButton).ColumnWidth = 5#
.Columns(ProjectInfoColumns.FileTimestamp).ColumnWidth = 14#
.Cells(1, ProjectInfoColumns.SelectCheckBox).Resize(.Rows.Count, 1).Interior.color = rgbWhite
.Cells(1, ProjectInfoColumns.DBName).Resize(.Rows.Count, 1).Interior.color = rgbWhite
.Cells(1, ProjectInfoColumns.FullPath).Resize(.Rows.Count, 1).Interior.color = rgbWhite
.Cells(1, ProjectInfoColumns.FileTimestamp).Resize(.Rows.Count, 1).NumberFormat = "dd-mmm-yyyy"
'--- the linked cell needs to have the same font color as the background
.Cells(1, ProjectInfoColumns.SelectedCellLink).Resize(.Rows.Count, 1).Font.color = XlRgbColor.rgbPaleTurquoise
End With
With headerArea
.Cells.Interior.color = XlRgbColor.rgbDarkBlue
.Cells.Font.color = XlRgbColor.rgbWhite
.Cells.Font.Bold = True
.Borders.LineStyle = xlContinuous
.Borders.color = XlRgbColor.rgbDarkGray
.Borders.Weight = xlThin
.WrapText = True
.HorizontalAlignment = xlCenter
.EntireRow.AutoFit
Dim i As Long
'--- start at _First+1 to skip the ProjectNumber column
For i = (ProjectInfoColumns.[_First] + 1) To ProjectInfoColumns.[_Last]
.Cells(1, i).Value = ProjectInfoColumnsName(i)
Next i
'--- the linked cell needs to have the same font color as the background
.Cells(1, .Columns.Count + 1).Font.color = XlRgbColor.rgbPaleTurquoise
End With
'--- label the project indexes
With projectArea
For i = 1 To .Rows.Count
.Cells(i, ProjectInfoColumns.ProjectNumber).Value = i
Next i
.Resize(.Rows.Count, 1).Font.Size = 8
End With
End Sub
Private Sub CreateBrowseButtons(ByRef ws As Worksheet, ByRef projectArea As Range)
Dim projectRow As Range
Set projectRow = projectArea.Resize(1, ProjectInfoColumns.[_Last])
Dim left As Double
Dim top As Double
Dim height As Double
Dim width As Double
Dim i As Long
For i = 1 To DEFAULT_PROJECT_ROWS
With projectRow
height = .height - 2
width = .Cells(1, ProjectInfoColumns.BrowseButton).width - 2
top = .top + 1
left = .Cells(1, ProjectInfoColumns.BrowseButton).left + 1
Dim btn As Button
Set btn = ws.Buttons.Add(left:=left, top:=top, _
height:=height, width:=width)
btn.Caption = "..."
btn.Enabled = True
btn.OnAction = "UserFileSelect"
Set projectRow = projectRow.Offset(1, 0)
End With
Next i
End Sub
Private Sub CreateCheckboxes(ByRef ws As Worksheet, ByRef projectArea As Range)
Dim projectRow As Range
Set projectRow = projectArea.Resize(1, ProjectInfoColumns.[_Last] + 1)
Dim left As Double
Dim top As Double
Dim height As Double
Dim width As Double
Dim cb As CheckBox
Dim i As Long
For i = 1 To DEFAULT_PROJECT_ROWS
With projectRow
top = .top + 1
height = .height - 2
width = 14
With .Cells(1, ProjectInfoColumns.SelectCheckBox)
'--- centered in the column
left = .left + (.width / 2#) - (width / 2#)
End With
End With
Set cb = ws.CheckBoxes.Add(left:=left, top:=top, _
height:=height, width:=width)
cb.Caption = vbNullString
cb.LinkedCell = projectRow.Cells(1, ProjectInfoColumns.SelectedCellLink).Address
projectRow.Cells(1, ProjectInfoColumns.SelectedCellLink).Value = False
'--- sometimes the height and width don't get correctly set during
' the Add call, so set them (again) here, with other settings
cb.height = height
cb.width = width
Set projectRow = projectRow.Offset(1, 0)
Next i
'--- now add the Select All checkbox above these
' keep the same height, width, and left position, but
' recalculate the Top to set it at the botton of the cell
Set projectRow = projectArea.Offset(-1, 0).Resize(1, ProjectInfoColumns.[_Last] + 1)
top = projectRow.top + projectRow.height - height - 2
Set cb = ws.CheckBoxes.Add(left:=left, top:=top, _
height:=height, width:=width)
cb.Caption = vbNullString
cb.OnAction = "CheckUncheckAll"
cb.LinkedCell = projectRow.Cells(1, ProjectInfoColumns.SelectedCellLink).Address
projectRow.Cells(1, ProjectInfoColumns.SelectedCellLink).Value = False
End Sub
Private Sub CreateImportButton(ByRef ws As Worksheet, _
ByRef importArea As Range)
Dim left As Double
Dim top As Double
Dim height As Double
Dim width As Double
With importArea
height = .height * 2#
width = .width * 2.5
left = .left
top = .top
Dim btn As Button
Set btn = ws.Buttons.Add(left:=left, top:=top, _
height:=height, width:=width)
btn.Caption = "Import Select Projects"
btn.Enabled = True
btn.OnAction = "ImportProjects"
End With
End Sub