6
\$\begingroup\$

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.

\$\endgroup\$
2
  • 2
    \$\begingroup\$ I noticed you have a property named 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 to SheetOne would avoid confusion. \$\endgroup\$
    – HackSlash
    Commented Apr 21, 2020 at 15:13
  • 1
    \$\begingroup\$ Good call, I've actually already run into problems with that elsewhere. Not sure why I never thought to change it, but thank you! \$\endgroup\$ Commented Apr 21, 2020 at 15:17

0

Browse other questions tagged or ask your own question.