UIHelperModule.bas

Attribute VB_Name = "UIHelperModule"
' Manufacturing Workflow Scheduler - UI Helper Module
' Created: April 2025
'
' This module contains helper functions for the user interface
' and provides consistent error handling across the application

Option Explicit

' Constants for UI elements
Public Const COLOR_HEADER As Long = 12611584    ' RGB(192, 192, 192)
Public Const COLOR_SUCCESS As Long = 13565952   ' RGB(192, 255, 192)
Public Const COLOR_WARNING As Long = 13041663   ' RGB(255, 255, 192)
Public Const COLOR_ERROR As Long = 13408767     ' RGB(255, 192, 192)
Public Const COLOR_HIGHLIGHT As Long = 16629143 ' RGB(255, 230, 153)

' Initialize the main dashboard
Public Sub InitializeDashboard()
    Dim wsDashboard As Worksheet
    
    ' Reference to dashboard sheet
    Set wsDashboard = ThisWorkbook.Sheets("Dashboard")
    
    ' Clear existing content
    wsDashboard.UsedRange.Clear
    
    ' Add header
    With wsDashboard.Range("B2")
        .Value = "Manufacturing Workflow Scheduler"
        .Font.Size = 16
        .Font.Bold = True
    End With
    
    ' Add version info
    wsDashboard.Range("B3").Value = "Version " & MainModule.VERSION
    
    ' Create main sections
    CreateDashboardSection wsDashboard, "B5", "Data Import", _
        "Import data from your ERP system and set up your manufacturing workflow."
    
    CreateDashboardSection wsDashboard, "B12", "Schedule Generation", _
        "Generate and optimize your manufacturing schedule based on your workflow."
    
    CreateDashboardSection wsDashboard, "B19", "Reports & Analysis", _
        "Generate reports and analyze your manufacturing schedule."
    
    CreateDashboardSection wsDashboard, "B26", "Export & Share", _
        "Export your schedule to CSV or share it with others."
    
    ' Add buttons
    AddDashboardButton wsDashboard, "B7", "Import Data from CSV", "MainModule.ImportCSVData"
    AddDashboardButton wsDashboard, "B9", "Import Workflow from CSV", "MainModule.ImportWorkflowFromCSV"
    AddDashboardButton wsDashboard, "D7", "Test Data Generation", "ValidationModule.GenerateTestData"
    AddDashboardButton wsDashboard, "D9", "Validate Data", "ValidationModule.RunAllValidations"
    
    AddDashboardButton wsDashboard, "B14", "Generate Schedule", "MainModule.GenerateSchedule"
    AddDashboardButton wsDashboard, "B16", "View Workflow", "UserFormModule.ShowWorkflowVisualization"
    AddDashboardButton wsDashboard, "D14", "Level Resources", "ResourceLevelingDialog"
    AddDashboardButton wsDashboard, "D16", "Optimize Schedule", "OptimizeScheduleDialog"
    
    AddDashboardButton wsDashboard, "B21", "Work Order Summary", "ReportingModule.GenerateScheduleSummary"
    AddDashboardButton wsDashboard, "B23", "Resource Utilization", "ReportingModule.GenerateResourceUtilizationReport"
    AddDashboardButton wsDashboard, "D21", "Department Workload", "ReportingModule.GenerateDepartmentWorkloadReport"
    AddDashboardButton wsDashboard, "D23", "Timeline (Gantt Chart)", "ReportingModule.GenerateTimelineReport"
    
    AddDashboardButton wsDashboard, "B28", "Export Schedule to CSV", "MainModule.ExportScheduleToCSV"
    AddDashboardButton wsDashboard, "D28", "Print Schedule", "PrintScheduleDialog"
    
    ' Add status section
    wsDashboard.Range("B32").Value = "Status:"
    With wsDashboard.Range("C32:F32")
        .Merge
        .Value = "Ready"
        .Font.Bold = True
        .Interior.Color = COLOR_SUCCESS
    End With
    
    ' Add navigation links
    wsDashboard.Range("H5").Value = "Quick Navigation:"
    wsDashboard.Range("H7").Value = "Dashboard"
    CreateHyperlink wsDashboard, "H7", "Dashboard", "A1"
    wsDashboard.Range("H8").Value = "Imported Data"
    CreateHyperlink wsDashboard, "H8", "ImportedData", "A1"
    wsDashboard.Range("H9").Value = "Workflow Setup"
    CreateHyperlink wsDashboard, "H9", "WorkflowSetup", "A1"
    wsDashboard.Range("H10").Value = "Parameters"
    CreateHyperlink wsDashboard, "H10", "Parameters", "A1"
    wsDashboard.Range("H11").Value = "Schedule"
    CreateHyperlink wsDashboard, "H11", "Schedule", "A1"
    wsDashboard.Range("H12").Value = "Reports"
    CreateHyperlink wsDashboard, "H12", "Reports", "A1"
    
    ' Add instructions
    wsDashboard.Range("H14").Value = "Quick Start:"
    wsDashboard.Range("H16").Value = "1. Import data from your ERP system"
    wsDashboard.Range("H17").Value = "2. Import or define your workflow"
    wsDashboard.Range("H18").Value = "3. Configure parameters"
    wsDashboard.Range("H19").Value = "4. Generate schedule"
    wsDashboard.Range("H20").Value = "5. View reports and analyze results"
    wsDashboard.Range("H21").Value = "6. Export or share schedule"
    
    ' Format cells
    wsDashboard.Columns.AutoFit
    
    ' Show dashboard
    wsDashboard.Activate
    
    ' Set focus on cell A1
    wsDashboard.Range("A1").Select
End Sub

' Create a section on the dashboard
Private Sub CreateDashboardSection(ws As Worksheet, cell As String, title As String, description As String)
    ' Add section title
    With ws.Range(cell)
        .Value = title
        .Font.Bold = True
        .Font.Size = 12
    End With
    
    ' Add horizontal line
    With ws.Range(cell).Offset(1, 0).Resize(1, 6)
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).Weight = xlThin
    End With
    
    ' Add description
    ws.Range(cell).Offset(0, 4).Value = description
End Sub

' Add a button to the dashboard
Private Sub AddDashboardButton(ws As Worksheet, cell As String, caption As String, action As String)
    Dim btn As Button
    
    ' Create button
    Set btn = ws.Buttons.Add(ws.Range(cell).Left, ws.Range(cell).Top, 120, 20)
    
    ' Configure button
    With btn
        .Caption = caption
        .OnAction = action
        .Name = "btn" & Replace(Replace(caption, " ", ""), "-", "")
    End With
End Sub

' Create a hyperlink
Private Sub CreateHyperlink(ws As Worksheet, cell As String, sheetName As String, target As String)
    ws.Hyperlinks.Add Anchor:=ws.Range(cell), Address:="", SubAddress:="'" & sheetName & "'!" & target
    ws.Range(cell).Font.ColorIndex = 5 ' Blue
    ws.Range(cell).Font.Underline = True
End Sub

' Show resource leveling dialog
Public Sub ResourceLevelingDialog()
    Dim response As VbMsgBoxResult
    Dim maxUtilization As String
    
    ' Check if schedule exists
    If Not SheetHasData("Schedule") Then
        ShowError "No schedule data found. Please generate a schedule first."
        Exit Sub
    End If
    
    ' Show input dialog
    maxUtilization = InputBox("Enter maximum resource utilization percentage (1-100):", _
                             "Resource Leveling", "90")
    
    ' Validate input
    If Not IsNumeric(maxUtilization) Then
        ShowError "Please enter a valid number."
        Exit Sub
    End If
    
    If CDbl(maxUtilization) < 1 Or CDbl(maxUtilization) > 100 Then
        ShowError "Please enter a value between 1 and 100."
        Exit Sub
    End If
    
    ' Confirm action
    response = MsgBox("This will adjust the schedule to prevent resource overallocation. Continue?", _
                     vbQuestion + vbYesNo, "Resource Leveling")
    
    If response = vbYes Then
        ' Level all resources
        LevelAllResources CDbl(maxUtilization) / 100
        ShowSuccess "Resources leveled successfully."
    End If
End Sub

' Level all resources in the schedule
Private Sub LevelAllResources(maxUtilization As Double)
    Dim wsSchedule As Worksheet
    Dim lastRow As Long
    Dim resources As Collection
    Dim i As Long
    
    ' Get reference to schedule sheet
    Set wsSchedule = ThisWorkbook.Sheets("Schedule")
    lastRow = wsSchedule.Cells(wsSchedule.Rows.Count, 1).End(xlUp).Row
    
    ' Get unique resources
    Set resources = New Collection
    On Error Resume Next
    For i = 2 To lastRow
        resources.Add wsSchedule.Cells(i, 6).Value, CStr(wsSchedule.Cells(i, 6).Value)
    Next i
    On Error GoTo 0
    
    ' Level each resource
    Dim resource As Variant
    For Each resource In resources
        UtilityModule.LevelResources CStr(resource), maxUtilization * 100
    Next resource
End Sub

' Show optimize schedule dialog
Public Sub OptimizeScheduleDialog()
    Dim response As VbMsgBoxResult
    
    ' Check if schedule exists
    If Not SheetHasData("Schedule") Then
        ShowError "No schedule data found. Please generate a schedule first."
        Exit Sub
    End If
    
    ' Confirm action
    response = MsgBox("This will optimize the schedule to minimize total production time. Continue?", _
                     vbQuestion + vbYesNo, "Optimize Schedule")
    
    If response = vbYes Then
        ' Optimize schedule
        OptimizeSchedule
        ShowSuccess "Schedule optimized successfully."
    End If
End Sub

' Optimize the schedule
Private Sub OptimizeSchedule()
    ' In a real implementation, this would use advanced algorithms
    ' to optimize the schedule. For now, we'll just level resources.
    LevelAllResources 0.9
End Sub

' Show print schedule dialog
Public Sub PrintScheduleDialog()
    Dim response As VbMsgBoxResult
    Dim wsSchedule As Worksheet
    
    ' Check if schedule exists
    If Not SheetHasData("Schedule") Then
        ShowError "No schedule data found. Please generate a schedule first."
        Exit Sub
    End If
    
    ' Confirm action
    response = MsgBox("This will print the current schedule. Continue?", _
                     vbQuestion + vbYesNo, "Print Schedule")
    
    If response = vbYes Then
        ' Print schedule
        Set wsSchedule = ThisWorkbook.Sheets("Schedule")
        wsSchedule.PrintOut
    End If
End Sub

' Show error message
Public Sub ShowError(message As String)
    MsgBox message, vbExclamation, "Error"
    
    ' Update status on dashboard
    UpdateDashboardStatus message, COLOR_ERROR
End Sub

' Show warning message
Public Sub ShowWarning(message As String)
    MsgBox message, vbExclamation, "Warning"
    
    ' Update status on dashboard
    UpdateDashboardStatus message, COLOR_WARNING
End Sub

' Show success message
Public Sub ShowSuccess(message As String)
    MsgBox message, vbInformation, "Success"
    
    ' Update status on dashboard
    UpdateDashboardStatus message, COLOR_SUCCESS
End Sub

' Update status on dashboard
Public Sub UpdateDashboardStatus(message As String, Optional color As Long = -1)
    Dim wsDashboard As Worksheet
    
    On Error Resume Next
    Set wsDashboard = ThisWorkbook.Sheets("Dashboard")
    If Err.Number <> 0 Then Exit Sub
    On Error GoTo 0
    
    ' Update status cell
    With wsDashboard.Range("C32:F32")
        .Value = message
        
        If color <> -1 Then
            .Interior.Color = color
        End If
    End With
End Sub

' Check if a sheet has data
Private Function SheetHasData(sheetName As String) As Boolean
    Dim ws As Worksheet
    
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets(sheetName)
    If Err.Number <> 0 Then
        SheetHasData = False
        Exit Function
    End If
    On Error GoTo 0
    
    SheetHasData = ws.UsedRange.Rows.Count > 1
End Function

' Create necessary sheets if they don't exist
Public Sub EnsureRequiredSheets()
    Dim sheetNames As Variant
    Dim i As Long
    
    sheetNames = Array("Dashboard", "ImportedData", "WorkflowSetup", "Parameters", "Schedule", "Reports")
    
    For i = LBound(sheetNames) To UBound(sheetNames)
        If Not SheetExists(sheetName:=sheetNames(i)) Then
            ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = sheetNames(i)
            
            ' Initialize special sheets
            Select Case sheetNames(i)
                Case "Dashboard"
                    InitializeDashboard
                Case "Parameters"
                    InitializeParametersSheet
            End Select
        End If
    Next i
End Sub

' Initialize the parameters sheet
Private Sub InitializeParametersSheet()
    Dim wsParams As Worksheet
    
    ' Reference to parameters sheet
    Set wsParams = ThisWorkbook.Sheets("Parameters")
    
    ' Clear existing content
    wsParams.UsedRange.Clear
    
    ' Add header
    With wsParams.Range("A1:B1")
        .Value = Array("Parameter", "Value")
        .Font.Bold = True
        .Interior.Color = COLOR_HEADER
    End With
    
    ' Add parameters
    wsParams.Range("A2").Value = "Start Date"
    wsParams.Range("B2").Value = Date
    wsParams.Range("B2").NumberFormat = "yyyy-mm-dd"
    
    wsParams.Range("A3").Value = "Working Hours Per Day"
    wsParams.Range("B3").Value = 8
    
    wsParams.Range("A4").Value = "Use Calendar Days"
    wsParams.Range("B4").Value = "No"
    
    wsParams.Range("A5").Value = "Max Resource Utilization %"
    wsParams.Range("B5").Value = 90
    
    wsParams.Range("A6").Value = "Schedule Priority"
    wsParams.Range("B6").Value = "Due Date"
    
    ' Add validation to Use Calendar Days
    With wsParams.Range("B4").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="Yes,No"
    End With
    
    ' Add validation to Schedule Priority
    With wsParams.Range("B6").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="Due Date,Priority,Resource Efficiency"
    End With
    
    ' Format
    wsParams.Columns.AutoFit
    
    ' Add description
    wsParams.Range("D1").Value = "Parameter Descriptions:"
    wsParams.Range("D1").Font.Bold = True
    
    wsParams.Range("D2").Value = "Start Date: Default start date for scheduling if not specified in work orders"
    wsParams.Range("D3").Value = "Working Hours Per Day: Used to convert durations to calendar time"
    wsParams.Range("D4").Value = "Use Calendar Days: If 'Yes', includes weekends in scheduling"
    wsParams.Range("D5").Value = "Max Resource Utilization %: Maximum allowed resource utilization"
    wsParams.Range("D6").Value = "Schedule Priority: Method used to prioritize scheduling"
End Sub

' Check if a sheet exists
Private Function SheetExists(sheetName As String) As Boolean
    Dim ws As Worksheet
    
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets(sheetName)
    On Error GoTo 0
    
    SheetExists = Not ws Is Nothing
End Function