Excel – Graphical Scheduled Usage Viewer for Production Equipment

1 01 2010

January 1, 2010

This article is based on a sample included in a presentation that I conducted a couple of months ago.  Essentially, this example pulls utilization schedules from multiple equipment resources and generates both an equipment resource specific calendar and a graphical overview of the calendars for all equipment resources.  This demonstration uses ADO with a direct connection to an Oracle database for both scheduling the work orders that need to be processed at each of the equipment resources (using a very weak scheduling algorithm that does not go back to fill in unused time), and to create the graphical results in Excel.

The options area for the original Excel spreadsheet used in my presentation looked like this, but we will not create anything that complex in this article: 

Before starting, we need to create source data for our example (note that some of the tables created are only needed for a short period of time, and may be dropped once all of the tables are created):

First, a statistic list of parts that will be manufactured:

CREATE TABLE
  T_PART_LIST AS
SELECT
  CAST(DBMS_RANDOM.STRING('U',15) AS VARCHAR2(30)) PART_ID,
  ROUND(DBMS_RANDOM.VALUE(1,30)) NUM_LOTS,
  ROUND(DBMS_RANDOM.VALUE(1,10)) NUM_OPERATIONS
FROM
  DUAL
CONNECT BY
  LEVEL<=100;

Next, the operation numbers and machine resources that will be used during the manufacture of each of the parts:

CREATE TABLE
  T_PART_OPERATION AS
SELECT
  PL.PART_ID,
  OP.RN*10 OPERATION_SEQ_NO,
  CAST(ROUND(DBMS_RANDOM.VALUE(0,10),2) AS NUMBER(22,2)) RUN_HOURS,
  CAST('MACHINE'||TO_CHAR(ROUND(DBMS_RANDOM.VALUE(1,100)),'000') AS VARCHAR2(15)) RESOURCE_ID
FROM
  T_PART_LIST PL,
  (SELECT
    ROWNUM RN
  FROM
    DUAL
  CONNECT BY
    LEVEL<=10) OP
WHERE
  OP.RN<=PL.NUM_OPERATIONS;

CREATE INDEX IND_T_PART_OP_PART_ID ON T_PART_OPERATION(PART_ID);

Next, the work order lots that will manufacture the parts:

CREATE TABLE
  T_WORKORDER_LIST AS
SELECT
  WO.WORKORDER_BASE_ID,
  CAST(LN.LOT_NUM AS VARCHAR2(3)) WORKORDER_LOT_ID,
  PL.PART_ID,
  TRUNC(SYSDATE+ROUND(DBMS_RANDOM.VALUE(0,400))) DESIRED_WANT_DATE
FROM
  (SELECT
    PART_ID,
    NUM_LOTS,
    ROWNUM RN
  FROM
    T_PART_LIST) PL,
  (SELECT
    CAST('W'||TO_CHAR(ROWNUM+10000) AS VARCHAR2(15)) WORKORDER_BASE_ID,
    ROWNUM RN
  FROM
    DUAL
  CONNECT BY
    LEVEL<=400) WO,
  (SELECT
    ROWNUM LOT_NUM
  FROM
    DUAL
  CONNECT BY
    LEVEL<=30) LN
WHERE
  PL.RN=WO.RN
  AND LN.LOT_NUM<=PL.NUM_LOTS
ORDER BY
  WO.WORKORDER_BASE_ID,
  LN.LOT_NUM;

Finally, a table that will eventually contain the schedules for the various machine resources:

CREATE TABLE T_RESOURCE_DAILY_SCH(
  RESOURCE_ID VARCHAR2(15),
  START_DATE DATE,
  FINISH_DATE DATE,
  RUN_HOURS NUMBER,
  PART_ID VARCHAR2(30),
  WORKORDER_BASE_ID VARCHAR2(15),
  WORKORDER_LOT_ID VARCHAR2(3),
  OPERATION_SEQ_NO NUMBER,
  DESIRED_WANT_DATE DATE,
  UNIT_ASSIGNED NUMBER);

CREATE INDEX IND_T_RESOURCE_DAILY_RES ON T_RESOURCE_DAILY_SCH(RESOURCE_ID);

We now switch to Excel to build the interface area with two ActiveX command buttons:

First, name the first worksheet as ShopCalendar  – this name is very important since it is referenced in the code for this example.  Next, add two ActiveX command buttons in the first two rows.  Give the first one the name cmdCreateSchedule, and the second one the name cmdDrawCalendar  – the names are not overly critical, but the names are referenced in the code.  Finally, double-click one of the buttons to access the Code Editor.

Delete any code that is shown in the Code Editor and add the following code:

Option Explicit

Dim dbDatabase As New ADODB.Connection 
Dim strDatabase As String
Dim strUserName As String
Dim strPassword As String
Private Function ConnectDatabase() As Integer
    Dim intResult As Integer

    On Error Resume Next

    If dbDatabase.State <> 1 Then
        'Connection to the database if closed
        strDatabase = "MyDB"
        strUserName = "MyUser"
        strPassword = "MyPassword"

        'Connect to the database
        'Oracle connection string
        dbDatabase.ConnectionString = "Provider=OraOLEDB.Oracle;Data Source=" & strDatabase & ";User ID=" & strUserName & ";Password=" & strPassword & ";ChunkSize=1000;FetchSize=100;"

        dbDatabase.ConnectionTimeout = 40
        dbDatabase.CursorLocation = adUseClient
        dbDatabase.Open

        If (dbDatabase.State <> 1) Or (Err <> 0) Then
            intResult = MsgBox("Could not connect to the database.  Check your user name and password." & vbCrLf & Error(Err), 16, "Excel Demo")

            ConnectDatabase = False
        Else
            ConnectDatabase = True
        End If
    Else
        ConnectDatabase = True
    End If
End Function

The above code is the basic logic needed to permit connecting to the Oracle database.  Next, add a reference to the ActiveX Data Objects.  Now we need to add the code for the scheduling routine – this code uses bind variables to minimize the number of hard parses:

Private Sub cmdCreateSchedule_Click()
    Dim intResult As Integer
    Dim strSQL As String
    Dim i As Integer
    Dim intResourceIndex As Integer      'Index that indicates the current resource ID index
    Dim strResourceID(100) As String     'Keep track of the new resource IDs read in
    Dim varResourceLastDate(100) As Date 'Keep track of the last date for the resource
    Dim strWorkOrderLast As String       'Used to make certain that the next operation starts after the previous
    Dim varWorkOrderLastDate As Date     'Used to make certain that the next operation starts after the previous
    Dim varScheduleStart As Date         'The first date in the schedule
    Dim snpData As ADODB.Recordset
    Dim comData As ADODB.Command

    intResult = ConnectDatabase
    If intResult = False Then
        Exit Sub
    End If

    'Set the starting point for all resources
    varScheduleStart = Now
    For i = 1 To 100
        strResourceID(i) = ""
        varResourceLastDate(i) = varScheduleStart
    Next i

    Set snpData = New ADODB.Recordset
    Set comData = New ADODB.Command

    'Retrieve the list of work order operations to be scheduled
    strSQL = "SELECT" & vbCrLf
    strSQL = strSQL & "  WO.WORKORDER_BASE_ID," & vbCrLf
    strSQL = strSQL & "  WO.WORKORDER_LOT_ID," & vbCrLf
    strSQL = strSQL & "  WO.PART_ID," & vbCrLf
    strSQL = strSQL & "  WO.DESIRED_WANT_DATE," & vbCrLf
    strSQL = strSQL & "  PO.OPERATION_SEQ_NO," & vbCrLf
    strSQL = strSQL & "  PO.RUN_HOURS," & vbCrLf
    strSQL = strSQL & "  PO.RESOURCE_ID" & vbCrLf
    strSQL = strSQL & "FROM" & vbCrLf
    strSQL = strSQL & "  T_WORKORDER_LIST WO," & vbCrLf
    strSQL = strSQL & "  T_PART_OPERATION PO" & vbCrLf
    strSQL = strSQL & "WHERE" & vbCrLf
    strSQL = strSQL & "  WO.PART_ID=PO.PART_ID" & vbCrLf
    strSQL = strSQL & "ORDER BY" & vbCrLf
    strSQL = strSQL & "  WO.DESIRED_WANT_DATE," & vbCrLf
    strSQL = strSQL & "  WO.PART_ID," & vbCrLf
    strSQL = strSQL & "  WO.WORKORDER_BASE_ID," & vbCrLf
    strSQL = strSQL & "  WO.WORKORDER_LOT_ID," & vbCrLf
    strSQL = strSQL & "  PO.OPERATION_SEQ_NO"
    snpData.Open strSQL, dbDatabase

    If snpData.State = 1 Then
        'Remove the previous run
        dbDatabase.Execute "TRUNCATE TABLE T_RESOURCE_DAILY_SCH"

        'Set up the ADO command object to use bind variables
        With comData
            strSQL = "INSERT INTO T_RESOURCE_DAILY_SCH (" & vbCrLf
            strSQL = strSQL & "  RESOURCE_ID," & vbCrLf
            strSQL = strSQL & "  START_DATE," & vbCrLf
            strSQL = strSQL & "  FINISH_DATE," & vbCrLf
            strSQL = strSQL & "  RUN_HOURS," & vbCrLf
            strSQL = strSQL & "  PART_ID," & vbCrLf
            strSQL = strSQL & "  WORKORDER_BASE_ID," & vbCrLf
            strSQL = strSQL & "  WORKORDER_LOT_ID," & vbCrLf
            strSQL = strSQL & "  OPERATION_SEQ_NO," & vbCrLf
            strSQL = strSQL & "  DESIRED_WANT_DATE," & vbCrLf
            strSQL = strSQL & "  UNIT_ASSIGNED)" & vbCrLf
            strSQL = strSQL & "VALUES (" & vbCrLf
            strSQL = strSQL & "  ?," & vbCrLf
            strSQL = strSQL & "  ?," & vbCrLf
            strSQL = strSQL & "  ?," & vbCrLf
            strSQL = strSQL & "  ?," & vbCrLf
            strSQL = strSQL & "  ?," & vbCrLf
            strSQL = strSQL & "  ?," & vbCrLf
            strSQL = strSQL & "  ?," & vbCrLf
            strSQL = strSQL & "  ?," & vbCrLf
            strSQL = strSQL & "  ?," & vbCrLf
            strSQL = strSQL & "  ?)"

            .Parameters.Append .CreateParameter("resource_id", adVarChar, adParamInput, 15, "")
            .Parameters.Append .CreateParameter("start_date", adDate, adParamInput, 8, Null)
            .Parameters.Append .CreateParameter("finish_date", adDate, adParamInput, 8, Null)
            .Parameters.Append .CreateParameter("run_hours", adNumeric, adParamInput, 12, 0)
            .Parameters.Append .CreateParameter("part_id", adVarChar, adParamInput, 30, "")
            .Parameters.Append .CreateParameter("workorder_base_id", adVarChar, adParamInput, 15, "")
            .Parameters.Append .CreateParameter("workorder_lot_id", adVarChar, adParamInput, 3, "")
            .Parameters.Append .CreateParameter("operation_seq_no", adNumeric, adParamInput, 12, 10)
            .Parameters.Append .CreateParameter("desired_want_date", adDate, adParamInput, 8, Null)
            .Parameters.Append .CreateParameter("unit_assigned", adNumeric, adParamInput, 12, 10)

            .CommandText = strSQL
            .CommandType = adCmdText
            .CommandTimeout = 30
            .ActiveConnection = dbDatabase
        End With

        dbDatabase.BeginTrans

        Do While Not snpData.EOF
            'Find the last operation date for this resource
            intResourceIndex = 0
            For i = 1 To 100
                If strResourceID(i) = snpData("resource_id") Then
                    intResourceIndex = i
                    Exit For
                End If
                If strResourceID(i) = "" Then
                    'No match found, create a new one
                    intResourceIndex = i
                    strResourceID(i) = snpData("resource_id")
                    Exit For
                End If
            Next i

            If strWorkOrderLast <> snpData("workorder_base_id") & "//" & snpData("workorder_lot_id") Then
                varWorkOrderLastDate = varScheduleStart
            End If

            If varResourceLastDate(intResourceIndex) >= varWorkOrderLastDate Then
                comData("start_date") = varResourceLastDate(intResourceIndex)
            Else
                comData("start_date") = varWorkOrderLastDate
            End If

            If varResourceLastDate(intResourceIndex) >= varWorkOrderLastDate Then
                comData("finish_date") = DateAdd("n", snpData("run_hours") * 60, varResourceLastDate(intResourceIndex))
                varWorkOrderLastDate = DateAdd("n", snpData("run_hours") * 60, varResourceLastDate(intResourceIndex))
            Else
                comData("finish_date") = DateAdd("n", snpData("run_hours") * 60, varWorkOrderLastDate)
                varWorkOrderLastDate = DateAdd("n", snpData("run_hours") * 60, varWorkOrderLastDate)
            End If

            varResourceLastDate(intResourceIndex) = varWorkOrderLastDate
            strWorkOrderLast = snpData("workorder_base_id") & "//" & snpData("workorder_lot_id")

            comData("resource_id") = snpData("resource_id")
            comData("run_hours") = snpData("run_hours")
            comData("part_id") = snpData("part_id")
            comData("workorder_base_id") = snpData("workorder_base_id")
            comData("workorder_lot_id") = snpData("workorder_lot_id")
            comData("operation_seq_no") = snpData("operation_seq_no")
            comData("desired_want_date") = snpData("desired_want_date")
            comData("unit_assigned") = 1

            'Execute the insert statement with bind variables
            comData.Execute

            snpData.MoveNext
        Loop
        snpData.Close

        'Issue a COMMIT
        dbDatabase.CommitTrans
    Else
        intResult = MsgBox("Could not query the database." & vbCrLf & Error(Err), 16, "Excel Demo")
    End If

    Set snpData = Nothing
    Set comData = Nothing
End Sub

Switch back to the Excel window and turn off Design Mode.  Clicking the Create Schedule button should populate the T_RESOURCE_DAILY_SCH table.  Once that code finishes executing, switch back to the Code Editor and add the following below the rest of the code:

Private Sub cmdDrawCalendar_Click()
    Dim i As Long
    Dim j As Integer
    Dim intFlag As Integer
    Dim intBaseRow As Integer
    Dim intBaseRowMax As Integer
    Dim intDataRow As Integer
    Dim intWeek As Integer
    Dim intResult As Integer
    Dim intWeekDay As Integer
    Dim intGraphicalMovable As Integer      'Determines if a graphical view will be created
    Dim intGraphicalFixed As Integer        'Determines if a graphical metafile will be created
    Dim strSQL As String
    Dim strLastResourceID As String
    Dim strLine As String
    Dim varWeekStart(1000) As Date
    Dim varWeekEnd(1000) As Date

    Dim lngBoxHeight As Long
    Dim lngBoxLengthMult As Single
    Dim lngFontSize As Long
    Dim lngBoxTop As Long
    Dim lngBoxLeft As Long
    Dim lngBoxWidth As Long
    Dim lngMaxCapacity As Long
    Dim varBaseDate As Date

    Dim lngResourceTop As Long     'Current top position for the resource ID

    Dim strFilename As String
    Dim snpData As ADODB.Recordset
    Dim comData As ADODB.Command

    'Don't break the code if an error is returned
    On Error Resume Next

    intGraphicalMovable = True
    intGraphicalFixed = False

    intResult = ConnectDatabase

    If intResult = False Then
        intResult = MsgBox("Could not connect to the Visual database.  Check your user name and password." & vbCrLf & Error(Err), 16, "Excel Demo")

        Exit Sub
    End If

    If intGraphicalFixed = True Then
        'See if we need to delete the worksheet from a previous execution
        For i = 1 To ActiveWorkbook.Sheets.Count
            If ActiveWorkbook.Sheets(i).Name = "ShopCalendarViewFixed" Then
                Sheets("ShopCalendarViewFixed").Select
                Application.DisplayAlerts = False
                ActiveWindow.SelectedSheets.Delete
                Application.DisplayAlerts = True
                Exit For
            End If
        Next i

        'Add a new worksheet to the workbook after the ShopCalendar worksheet
        ActiveWorkbook.Sheets.Add , Sheets("ShopCalendar")
        ActiveWorkbook.ActiveSheet.Name = "ShopCalendarViewFixed"
    End If

    If intGraphicalMovable = True Then
        'See if we need to delete the worksheet from a previous execution
        For i = 1 To ActiveWorkbook.Sheets.Count
            If ActiveWorkbook.Sheets(i).Name = "ShopCalendarView" Then
                Sheets("ShopCalendarView").Select
                Application.DisplayAlerts = False
                ActiveWindow.SelectedSheets.Delete
                Application.DisplayAlerts = True
                Exit For
            End If
        Next i

        'Add a new worksheet to the workbook after the ShopCalendar worksheet
        ActiveWorkbook.Sheets.Add , Sheets("ShopCalendar")
        ActiveWorkbook.ActiveSheet.Name = "ShopCalendarView"
    End If

    Sheets("ShopCalendar").Select

    Set snpData = New ADODB.Recordset
    Set comData = New ADODB.Command

    Sheets("ShopCalendar").Rows("13:10000").Delete Shift:=xlUp

    With comData
        strSQL = "SELECT" & vbCrLf
        strSQL = strSQL & "  RESOURCE_ID," & vbCrLf
        strSQL = strSQL & "  START_DATE," & vbCrLf
        strSQL = strSQL & "  FINISH_DATE," & vbCrLf
        strSQL = strSQL & "  RUN_HOURS," & vbCrLf
        strSQL = strSQL & "  PART_ID," & vbCrLf
        strSQL = strSQL & "  WORKORDER_BASE_ID," & vbCrLf
        strSQL = strSQL & "  WORKORDER_LOT_ID," & vbCrLf
        strSQL = strSQL & "  OPERATION_SEQ_NO," & vbCrLf
        strSQL = strSQL & "  DESIRED_WANT_DATE," & vbCrLf
        strSQL = strSQL & "  UNIT_ASSIGNED" & vbCrLf
        strSQL = strSQL & "FROM" & vbCrLf
        strSQL = strSQL & "  T_RESOURCE_DAILY_SCH" & vbCrLf
        strSQL = strSQL & "WHERE" & vbCrLf
        strSQL = strSQL & "  START_DATE<=TRUNC(SYSDATE+45)" & vbCrLf
        strSQL = strSQL & "ORDER BY" & vbCrLf
        strSQL = strSQL & "  RESOURCE_ID," & vbCrLf
        strSQL = strSQL & "  START_DATE," & vbCrLf
        strSQL = strSQL & "  FINISH_DATE," & vbCrLf
        strSQL = strSQL & "  WORKORDER_BASE_ID," & vbCrLf
        strSQL = strSQL & "  WORKORDER_LOT_ID"

        'Set up the command properties
        .CommandText = strSQL
        .CommandType = adCmdText
        .CommandTimeout = 30
        .ActiveConnection = dbDatabase
    End With

    Set snpData = comData.Execute

    varBaseDate = Date
    lngBoxLengthMult = 0.1
    lngBoxHeight = 8
    lngResourceTop = 30
    lngFontSize = 6

    varBaseDate = Date

    If Not (snpData Is Nothing) Then
    'If snpData.State = 1 Then
        Application.ScreenUpdating = False

        If intGraphicalMovable = True Then
            For i = 0 To 30
                lngBoxLeft = 70 + lngBoxLengthMult * (i * 60 * 24)
                lngBoxWidth = lngBoxLengthMult * (60 * 24) - 1
                With Sheets("ShopCalendarView").Shapes.AddTextbox(msoTextOrientationHorizontal, lngBoxLeft, lngBoxTop, lngBoxWidth, (lngBoxHeight * 2 - 1))
                    With .TextFrame
                        .Characters.Text = Format(DateAdd("d", i, varBaseDate), "m/d")
                        .Characters.Font.Size = (lngBoxHeight - 2) * 2
                    End With
                    .Fill.ForeColor.RGB = RGB(255 - 4 * (Weekday(DateAdd("d", i, varBaseDate), vbMonday) - 1), 255 - 4 * (Weekday(DateAdd("d", i, varBaseDate), vbMonday) - 1), 255 - 4 * (Weekday(DateAdd("d", i, varBaseDate), vbMonday) - 1))
                End With
            Next i
        End If

        If Not (snpData.EOF) Then
            intBaseRowMax = 10

            'Find the week start and end dates of each week
            varWeekStart(1) = CDate(Format(DateAdd("d", -Weekday(snpData("start_date"), vbMonday) + 1, snpData("start_date")), "mm/dd/yyyy"))
            varWeekEnd(1) = DateAdd("d", 6, varWeekStart(1))
            For i = 2 To 1000
                varWeekStart(i) = DateAdd("d", (i - 1) * 7, varWeekStart(1))
                varWeekEnd(i) = DateAdd("d", 6, varWeekStart(i))
            Next i

            Do While Not snpData.EOF
                If strLastResourceID <> snpData("resource_id") Then
                    'Started a new resource ID
                    If intBaseRow > 10 Then
                        'Write out the week start dates for the last resource, and draw the borders
                        For i = intBaseRow To intBaseRowMax - 1
                            Sheets("ShopCalendar").Cells(i + 1, 1).Value = Format(varWeekStart(i - intBaseRow + 1), "mm/dd/yyyy")
                        Next i

                        Sheets("ShopCalendar").Range("B" & Format(intBaseRow) & ":H" & Format(intBaseRowMax)).Select
                        With Selection.Borders(xlEdgeLeft)
                            .Weight = xlThick
                        End With
                        With Selection.Borders(xlEdgeTop)
                            .Weight = xlThick
                        End With
                        With Selection.Borders(xlEdgeBottom)
                            .Weight = xlThick
                        End With
                        With Selection.Borders(xlEdgeRight)
                            .Weight = xlThick
                        End With
                        With Selection.Borders(xlInsideVertical)
                            .Weight = xlThin
                        End With
                        With Selection.Borders(xlInsideHorizontal)
                            .Weight = xlThin
                        End With
                    End If

                    If intGraphicalMovable = True Then
                        'For the graphical view
                        lngResourceTop = lngResourceTop + lngMaxCapacity * (lngBoxHeight) + 10
                        lngBoxLeft = 1
                        lngBoxWidth = 40
                        lngBoxTop = lngResourceTop

                        With Sheets("ShopCalendarView").Shapes.AddTextbox(msoTextOrientationHorizontal, lngBoxLeft, lngBoxTop, lngBoxWidth, (lngBoxHeight - 1))
                            With .TextFrame
                                '.AutoMargins = False
                                .Characters.Text = snpData("resource_id")
                                .Characters.Font.Size = lngBoxHeight - 2
                                .MarginLeft = 0
                                .MarginRight = 0
                                .MarginTop = 0
                                .MarginBottom = 0
                            End With
                            .Fill.ForeColor.RGB = RGB(255, 255, 255)
                        End With
                    End If

                    lngMaxCapacity = 0

                    intBaseRow = intBaseRowMax + 4
                    strLastResourceID = snpData("resource_id")

                    Sheets("ShopCalendar").Cells(intBaseRow - 1, 1).Value = snpData("resource_id")
                    Sheets("ShopCalendar").Cells(intBaseRow - 1, 1).Font.Bold = True
                    Sheets("ShopCalendar").Cells(intBaseRow - 1, 1).Font.Size = 14
                    For i = 1 To 7
                        Sheets("ShopCalendar").Cells(intBaseRow, i + 1).Value = Format(DateAdd("d", i - 1, varWeekStart(1)), "DDD")
                        Sheets("ShopCalendar").Cells(intBaseRow, i + 1).Font.Bold = True
                    Next i
                End If

                If Not IsNull(snpData("unit_assigned")) Then
                   If lngMaxCapacity < snpData("unit_assigned") Then
                        'Need to update the maximum unit assigned value
                        lngMaxCapacity = snpData("unit_assigned")
                    End If

                    If (varBaseDate < snpData("start_date")) Or (varBaseDate < snpData("finish_date")) Then
                        If lngMaxCapacity < snpData("unit_assigned") Then
                            lngMaxCapacity = snpData("unit_assigned")
                        End If

                        If intGraphicalMovable = True Then
                            lngBoxLeft = 70 + lngBoxLengthMult * (DateDiff("n", varBaseDate, snpData("start_date")))
                            lngBoxWidth = lngBoxLengthMult * ((DateDiff("n", varBaseDate, snpData("finish_date")) - DateDiff("n", varBaseDate, snpData("start_date"))))
                            lngBoxTop = lngResourceTop + snpData("unit_assigned") * lngBoxHeight

                            With Sheets("ShopCalendarView").Shapes.AddTextbox(msoTextOrientationHorizontal, lngBoxLeft, lngBoxTop, lngBoxWidth, (lngBoxHeight - 1))
                                With .TextFrame
                                    '.AutoMargins = False
                                    .Characters.Text = snpData("workorder_base_id") & "/" & snpData("workorder_lot_id") & " OP " & CStr(snpData("operation_seq_no"))
                                    .Characters.Font.Size = lngBoxHeight - 2
                                    .MarginLeft = 0
                                    .MarginRight = 0
                                    .MarginTop = 0
                                    .MarginBottom = 0
                                End With
                                If snpData("finish_date") > snpData("desired_want_date") Then
                                    .Fill.ForeColor.RGB = RGB(255, 0, 0)
                                Else
                                    .Fill.ForeColor.RGB = RGB(0, 255, 255)
                                End If
'                                If snpData("workorder_sub_id") = "0" Then
                                    .AlternativeText = "WO:" & snpData("workorder_base_id") & "/" & snpData("workorder_lot_id") & " OP:" & CStr(snpData("operation_seq_no")) & Chr(10) & "Part ID:" & snpData("part_id") & Chr(10) & Format(snpData("start_date"), "mm/dd/yyyy hh:nn") & " - " & Format(snpData("finish_date"), "mm/dd/yyyy hh:nn") & Chr(10) & snpData("resource_id")
'                                Else
'                                    .AlternativeText = "WO:" & snpData("workorder_base_id") & "-" & snpData("workorder_sub_id") & "/" & snpData("workorder_lot_id") & " OP:" & CStr(snpData("sequence_no")) & Chr(10) & "Part ID:" & snpData("part_id") & Chr(10) & Format(snpData("start_date"), "mm/dd hh:nn") & " - " & Format(snpData("finish_date"), "mm/dd hh:nn") & Chr(10) & snpData("resource_id")
'                                End If
                            End With
                        End If
                    End If
                End If
                For i = 0 To DateDiff("d", CDate(Format(snpData("start_date"), "mm/dd/yyyy")), CDate(Format(snpData("finish_date"), "mm/dd/yyyy")))
                    intWeekDay = Weekday(DateAdd("d", i, snpData("start_date")), vbMonday) 'Column
                    'Find the row to place the information into
                    For j = 1 To 1000
                        If varWeekEnd(j) >= CDate(Format(DateAdd("d", i, snpData("start_date")), "mm/dd/yyyy")) Then
                            'Found the week for this record
                            intDataRow = intBaseRow + j

                            If intDataRow > intBaseRowMax Then
                                intBaseRowMax = intDataRow
                            End If
                            Exit For
                        End If
                    Next j
                    If (i = 0) And (i = DateDiff("d", CDate(Format(snpData("start_date"), "mm/dd/yyyy")), CDate(Format(snpData("finish_date"), "mm/dd/yyyy")))) Then
                        'Need to include the start time and the end time
                        strLine = Format(snpData("start_date"), "hh:nn") & " - " & Format(snpData("finish_date"), "hh:nn") & "  " & snpData("part_id")
                    Else
                        If i = 0 Then
                            'Need to include the start time
                            strLine = Format(snpData("start_date"), "hh:nn") & " - C0:00" & "  " & snpData("part_id")
                        Else
                            If i = DateDiff("d", CDate(Format(snpData("start_date"), "mm/dd/yyyy")), CDate(Format(snpData("finish_date"), "mm/dd/yyyy"))) Then
                                'Need to include the end time
                                strLine = "C0:00" & " - " & Format(snpData("finish_date"), "hh:nn") & "  " & snpData("part_id")
                            Else
                                'Operation is continuing through this date
                                strLine = "C0:00" & " - C0:00" & "  " & snpData("part_id")
                            End If
                        End If
                    End If
                    strLine = strLine & "  " & snpData("workorder_base_id")
'                    If snpData("workorder_sub_id") <> "0" Then
'                        strLine = strLine & "-" & snpData("workorder_sub_id")
'                    End If
                    strLine = strLine & "/" & snpData("workorder_lot_id")
                    strLine = strLine & " OP " & Format(snpData("operation_seq_no"))

                    If Sheets("ShopCalendar").Cells(intDataRow, intWeekDay + 1).Value = "" Then
                        'Writing into a new cell
                        Sheets("ShopCalendar").Cells(intDataRow, intWeekDay + 1).Value = strLine
                    Else
                        'Writing into a cell already containing data
                        Sheets("ShopCalendar").Cells(intDataRow, intWeekDay + 1).Value = Sheets("ShopCalendar").Cells(intDataRow, intWeekDay + 1).Value & Chr(10) & strLine
                    End If
                Next i
                snpData.MoveNext
            Loop

            If intBaseRow > 10 Then
                'Write out the week start dates for the last resource
                For i = intBaseRow To intBaseRowMax - 1
                    Sheets("ShopCalendar").Cells(i + 1, 1).Value = Format(varWeekStart(i - intBaseRow + 1), "mm/dd/yyyy")
                Next i

                Sheets("ShopCalendar").Range("B" & Format(intBaseRow) & ":H" & Format(intBaseRowMax)).Select
                Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                With Selection.Borders(xlEdgeLeft)
                    .Weight = xlThick
                End With
                With Selection.Borders(xlEdgeTop)
                    .Weight = xlThick
                End With
                With Selection.Borders(xlEdgeBottom)
                    .Weight = xlThick
                End With
                With Selection.Borders(xlEdgeRight)
                    .Weight = xlThick
                End With
                With Selection.Borders(xlInsideVertical)
                    .Weight = xlThin
                End With
                With Selection.Borders(xlInsideHorizontal)
                    .Weight = xlThin
                End With
            End If
        End If
        snpData.Close
    End If

    Sheets("ShopCalendar").Rows("10:" & Format(intBaseRowMax)).VerticalAlignment = xlTop

    Sheets("ShopCalendar").PageSetup.PrintArea = "$A$13:$H$" & Format(intBaseRowMax)
    With Sheets("ShopCalendar").PageSetup
        .CenterFooter = "Generated " & Format(Now, "mm/dd/yyyy hh:nn")
        .RightFooter = "Page &P of &N"
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintGridlines = False
        .Orientation = xlLandscape
         '.PaperSize = xlPaperLetter
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 300
    End With

    Sheets("ShopCalendar").Range("B2").Select
    ActiveWindow.FreezePanes = True

    Sheets("ShopCalendar").Columns("B:H").Select
    Selection.ColumnWidth = 44
    Selection.WrapText = True

    Sheets("ShopCalendar").Columns("A:A").ColumnWidth = 10.43
    Sheets("ShopCalendar").Range("A13").Select
    Application.ScreenUpdating = True

    Set snpData = Nothing
    Set comData = Nothing
End Sub

With the above code added, the Draw Calendar button should now work.  Click the Draw Calendar button, the output should look something like what you see below:

A second tab is added to the worksheet that shows a graphical overview, with cyan colored bars representing operations that will complete before the work order due date and red colored bars representing operations that will complete after the work order due date:

I may post a follow-up at some point that shows how to generate an enhanced Windows metafile (EMF) which shows the graphical view of the resource utilization.


Actions

Information

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s




Follow

Get every new post delivered to your Inbox.

Join 141 other followers

%d bloggers like this: