My goal: to make the already easy task of filling out an excel sheet 1% easier by putting in hours and hours of effort. On a more serious note, I'm currently developing a system to manage inventory at my work. The following is my attempt to smooth out the process of receiving inventory when it arrives. To help visualize, here's an example of what the PO sheet might look like (obviously not actual data)
To start with, I took a page (or two, or three, or ten) out of Rubberduck's book and proxied up my workbook:
Option Explicit
Private Type TProxy
Sheet1 As IInventorySheetProxy
POSheet As IPOSheetProxy
End Type
Private this As TProxy
Public Property Get Sheet1() As IInventorySheetProxy
Set Sheet1 = this.Sheet1
End Property
Public Property Get POSheet() As IPOSheetProxy
Set POSheet = this.POSheet
End Property
Private Sub Class_Initialize()
Set this.Sheet1 = New Sheet1Proxy
Set this.POSheet = New POSheetProxy
End Sub
Private Sub Class_Terminate()
Set this.Sheet1 = Nothing
Set this.POSheet = Nothing
End Sub
In order to proxy the whole workbook, one must encapsulate the relevant worksheets so here's what POSheetProxy looks like (the interface looks exactly how you'd expect):
Option Explicit
Implements IPOSheetProxy
Private Property Get Table() As ListObject
Set Table = Sheet2.ListObjects(1)
End Property
Private Property Get PONumberColumnIndex() As Long
PONumberColumnIndex = Table.ListColumns("PO # Issued").Index
End Property
Private Property Get LocationColumnIndex() As Long
LocationColumnIndex = Table.ListColumns("Location").Index
End Property
Private Property Get ItemColumnIndex() As Long
ItemColumnIndex = Table.ListColumns("Item").Index
End Property
Private Property Get DescriptionColumnIndex() As Long
DescriptionColumnIndex = Table.ListColumns("Description").Index
End Property
Private Property Get CompanyColumnIndex() As Long
CompanyColumnIndex = Table.ListColumns("Parts Company").Index
End Property
Private Property Get QuantOrderedColumnIndex() As Long
QuantOrderedColumnIndex = Table.ListColumns("Quantity Ordered").Index
End Property
Private Property Get QuantReceivedColumnIndex() As Long
QuantReceivedColumnIndex = Table.ListColumns("Quantity Received").Index
End Property
Private Property Get IPOSheetProxy_Data() As Collection
Dim result As Collection
Set result = New Collection
Dim currentRow As ListRow
For Each currentRow In Table.ListRows
Dim currentPO As ModelPO
Set currentPO = New ModelPO
'ModelPO encapsulates a row in Table as an object'
currentPO.Company = currentRow.Range(columnindex:=CompanyColumnIndex).value
currentPO.Description = currentRow.Range(columnindex:=DescriptionColumnIndex).value
currentPO.ItemNum = currentRow.Range(columnindex:=ItemColumnIndex).value
currentPO.Location = currentRow.Range(columnindex:=LocationColumnIndex).value
currentPO.PONumber = currentRow.Range(columnindex:=PONumberColumnIndex).value
currentPO.QuantOrd = currentRow.Range(columnindex:=QuantOrderedColumnIndex).value
currentPO.QuantRec = currentRow.Range(columnindex:=QuantReceivedColumnIndex).value
result.Add currentPO
Next
Set IPOSheetProxy_Data = result
End Property
Public Sub IPOSheetProxy_Update(ByVal value As ModelPO)
Dim currentRow As ListRow
For Each currentRow In Table.ListRows
If currentRow.Range(columnindex:=PONumberColumnIndex).value = value.PONumber And _
currentRow.Range(columnindex:=DescriptionColumnIndex).value = value.Description And _
currentRow.Range(columnindex:=ItemColumnIndex).value = value.ItemNum Then
currentRow.Range(columnindex:=QuantOrderedColumnIndex).value = value.QuantOrd
currentRow.Range(columnindex:=QuantReceivedColumnIndex).value = value.QuantRec
Exit Sub
End If
Next
End Sub
With that out of the way, let's get to actually starting the process.
Calling code (Module1):
Public Sub ReceiveFromPO()
Dim proxy As WbkProxy
Set proxy = New WbkProxy
With New ReceivePOPresenter
.Show proxy, InputBox("Please enter the PO Number")
End With
End Sub
ReceivePOPresenter: - prepares the data entry form and handles the data when it's done
Option Explicit
Private wbproxy As WbkProxy
'@MemberAttribute VB_VarHelpID, -1 '
Private WithEvents view As ReceivePOForm
Private Property Get form() As IFormView
Set form = view
End Property
Public Sub Show(ByVal proxy As WbkProxy, ByVal value As String)
Set wbproxy = proxy
Set view = New ReceivePOForm
Dim viewmodel As JustValuesModel
Set viewmodel = New JustValuesModel
Dim current As ModelPO
Dim result As Collection
Set result = New Collection
For Each current In wbproxy.POSheet.Data
If current.PONumber = value Then
If Len(CStr(current.QuantRec)) = 0 Then current.QuantRec = 0
result.Add current
End If
Next
Set viewmodel.PossibleValues = result
If form.showForm(viewmodel) Then Receive viewmodel
Set view = Nothing
End Sub
Private Sub Receive(ByVal viewmodel As JustValuesModel)
Dim current As ModelPO
For Each current In viewmodel.PossibleValues
wbproxy.POSheet.Update current
Next
End Sub
Private Sub view_Receive(ByVal viewmodel As JustValuesModel)
Receive viewmodel
End Sub
ReceivePOForm: - creates labels and textboxes for each line item in the PO (Here's an example of what it might look like)
Option Explicit
Public Event Receive(ByVal viewmodel As JustValuesModel)
Private Type TView
isCancelled As Boolean
Model As JustValuesModel
End Type
Private this As TView
Implements IFormView
Private Sub FinishButton_Click()
If Validate = False Then Exit Sub
UpdateModel
RaiseEvent Receive(this.Model)
OnCancel
End Sub
Private Function IFormView_ShowForm(ByVal viewmodel As Object) As Boolean
Set this.Model = viewmodel
Me.Show vbModal
IFormView_ShowForm = Not this.isCancelled
End Function
Private Sub UserForm_Activate()
Dim i As Long
i = 0
Dim current As ModelPO
For Each current In this.Model.PossibleValues
CreateDescriptionLabel current, i
CreateQuantityLabel current, i
CreateQuantityBox i
i = i + 1
Next
AdjustFormHeight
End Sub
Private Sub CreateDescriptionLabel(ByVal value As ModelPO, ByVal previousLabels As Long)
Const PADDING = 12
Const TOP_MARGIN = 24
Const LABEL_HEIGHT = 12
Const LEFT_MARGIN = 12
Const LABEL_WIDTH = 228
Dim label As Control
Set label = Me.Controls.Add("Forms.Label.1", "DescriptionLabel" & previousLabels + 1)
label.Left = LEFT_MARGIN
label.Height = LABEL_HEIGHT
label.Width = LABEL_WIDTH
label.Top = TOP_MARGIN + (previousLabels * (LABEL_HEIGHT + PADDING))
Me.Controls("DescriptionLabel" & previousLabels + 1).Caption = value.Description
End Sub
Private Sub CreateQuantityLabel(ByVal value As ModelPO, ByVal previousLabels As Long)
'DRY?'
Const PADDING = 12
Const TOP_MARGIN = 24
Const LABEL_HEIGHT = 12
Const LEFT_MARGIN = 264
Const LABEL_WIDTH = 48
Const CENTERED = 2
Dim label As Control
Set label = Me.Controls.Add("Forms.Label.1", "QLabel" & previousLabels + 1)
label.Left = LEFT_MARGIN
label.Height = LABEL_HEIGHT
label.Width = LABEL_WIDTH
label.Top = TOP_MARGIN + (previousLabels * (LABEL_HEIGHT + PADDING))
Me.Controls("QLabel" & previousLabels + 1).Caption = value.QuantOrd - value.QuantRec
Me.Controls("QLabel" & previousLabels + 1).TextAlign = CENTERED
End Sub
Private Sub CreateQuantityBox(ByVal previousBoxes As Long)
Const PADDING = 6
Const BOX_HEIGHT = 18
Const LEFT_MARGIN = 330
Const TOP_MARGIN = 24
Const BOX_WIDTH = 42
Dim box As Control
Set box = Me.Controls.Add("Forms.TextBox.1", "QBox" & previousBoxes + 1)
box.Left = LEFT_MARGIN
box.Height = BOX_HEIGHT
box.Width = BOX_WIDTH
box.Top = TOP_MARGIN + (previousBoxes * (BOX_HEIGHT + PADDING))
End Sub
Private Sub AdjustFormHeight()
Const PADDING = 20
Const ENABLED = 2
Dim current As Control
Dim maxLength As Long
maxLength = 0
For Each current In Me.Controls
If current.Top + current.Height > maxLength And current.Name <> "FinishButton" Then
maxLength = current.Top + current.Height
End If
Next
Dim finish As Control
Set finish = Me.Controls("FinishButton")
finish.Top = maxLength + PADDING
If Me.Height < (finish.Top + finish.Height) Then
'add scrollbars'
Me.ScrollBars = ENABLED
Me.ScrollHeight = finish.Top + finish.Height + PADDING
Else
'shrink'
Me.Height = finish.Top + finish.Height + 2 * PADDING
End If
End Sub
Private Function Validate() As Boolean
Dim i As Long
For i = 1 To this.Model.PossibleValues.Count
If Len(Me.Controls("QBox" & i).value) <> 0 And Not IsNumeric(Me.Controls("QBox" & i).value) Then
MsgBox "Please only enter numbers in the quantity boxes."
Validate = False
Exit Function
End If
Next
Validate = True
End Function
Private Sub UpdateModel()
Dim i As Long
i = 0
Dim current As ModelPO
For Each current In this.Model.PossibleValues
i = i + 1
If Len(CStr(Me.Controls("QBox" & i).value)) <> 0 Then
current.QuantRec = current.QuantRec + Me.Controls("QBox" & i).value
End If
Next
End Sub
Private Sub OnCancel()
this.isCancelled = True
Me.Hide
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = VbQueryClose.vbFormControlMenu Then
Cancel = True
OnCancel
End If
End Sub
This is where I feel I may have fallen off the wagon a bit. I'm worried that my userform code smells a little bit like Smart-UI, but I had a hard time trying to model the data when you don't know going in how many textboxes there will be.
Speaking of models, here's JustValuesModel: - holds the info for all the items on the PO
Option Explicit
Private Type TModel
PossibleValues As Collection
End Type
Private this As TModel
Public Property Get PossibleValues() As Collection
Set PossibleValues = this.PossibleValues
End Property
Public Property Set PossibleValues(ByVal value As Collection)
Set this.PossibleValues = value
End Property
I wanted to try to model the textbox values somehow, but nothing I came up with was ideal (hence the UpdateModel procedure in the userform).
Lastly, here's the view interface (very simple):
Option Explicit
Public Function showForm(ByVal viewmodel As Object) As Boolean
End Function
Private Sub Class_Initialize()
Err.Raise 5, , "Interface class must not be instantiated."
End Sub
Sorry this is so long! I'm still rather new to OOP so I'd like to improve on my fundamentals (e.g. SOLID), but improvements of any kind are very welcome. Also, please let me know if I missed something and I'll edit it in.
Sheet1
which is a common object name in Excel. I would want to avoid name collisions like this because it's ambiguous. Even changing the name toSheetOne
would avoid confusion. \$\endgroup\$