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.
Hello Mr Hooper!
you give me sample files of Excel Schedule Viewer?
email: flaviohenrique2002@hotmail.com
https://hoopercharles.wordpress.com/2010/01/01/excel-schedule-viewer/
Flavio,
If you have a copy of Microsoft Excel, even the 2016 version, you should be able to very quickly create the sample Excel files by following the directions in this article. All of the necessary code is included in the article. I originally created this example for a presentation that I gave to a Visual Manufacturing user group in June 2009. If you are a member of the VMIUG-TEC Yahoo group, you can access the full set of sample files and my presentation from that group’s file area.
Hi, Mr. Charles Hooper,
please get the Excel file of your VMIUG-TEC Yahoo group, i am not acepted in Yahoo Group, not have access.
or add me (accept me) to the group.
link https://beta.groups.yahoo.com/neo/groups/VMIUG-TEC/info
“https://beta.groups.yahoo.com/neo/groups/VMIUG-TEC/info”
thanks,
Flavio Henrique.
Flavio,
This article describes my 2016 presentation, which includes the Excel Schedule viewer:
https://hoopercharles.wordpress.com/2016/11/02/huge-presentation-working-with-oracle-database-in-c-vbscript-and-excel-enhancing-visual-manufacturing-8-0-0/
The presentation and support files may be downloaded from the following Google Drive link:
https://goo.gl/mOUGRV
Hi, Charles Hooper,
greate!
thank you very, very, very mutch!!!!
Flavio.