Forum Discussion
Making an add on
John-project whilst I didn't use the code in the example you posted I did build off some code you provided on a https://social.technet.microsoft.com/Forums/projectserver/en-US/a8f15497-e036-49f4-834d-8f84276e5869/project-2013-how-to-create-a-resource-working-time-exception-report?forum=projectprofessional2010general but until I went back just now to look at my sources I hadn't realised you were involved 🙂 I couldn't thank you at the time so I will do so now! Thank you 🙂 The internet is fantastic as it allows people like me to "magpie code" and build solutions which would otherwise be beyond my capabilities (see below)
🙂
Thank you!
Miles
The most likely reason you got a runtime error when you tried to run the macro I referenced is because you did not set a reference for the Excel object library. With the macro code showing in the VBE window, go to Tools > References. Locate the Excel object library and select it. Once it is "associated" with the macro, you won't have to select it again. Some of the later macros I've written check for this automatically.
The reference you cited is the original thread that started the macro. That's why I listed Kiran K. as the original author.
Keep in mind that code posted on user forums is not intended to be claimed and sold by others, something you eluded to in your original post. We post it as open-sourced for the benefit of everyone. If you create some original work (not adapted from posted code), that's a different story.
John-project This does take a few seconds to run and finish the formatting however my actual product (https://www.summarypro.co.uk/) does take about a minute to update a summary plan however that is at least as fast as doing it manually and has no errors which is key 🙂
I didn't try your code but it looks like you added some more "whiz bang" stuff which is always nice as long as it doesn't slow down processing. I've written macros that do a whole lot of processing and export to Excel and they run in a few seconds but this past year I wrote a macro for a user who wanted to export a heavily formatted Gantt chart view to Excel with all the formatting and it takes close to a full minute to complete. People love their graphics.
I see you have an issue with setting the FreezePanes in Excel. I have the same issue on a macro I wrote recently. Sometimes it works without issue and other times it flags an "can't do" error. I haven't quite figured out why but that didn't happen with earlier versions of Project/Office.
John-project You make a very valid point about the open source nature and looking back at the macro I see that back in 2016 I used a lot of it, far more than would allow me to mentally claim the majority of the work was mine!. I can't contribute to the original anymore so here is my adaption and build on the code;
Dim row As Integer Dim MyXL As Object Dim E As Exception Dim Shift_finish As String Dim shift_start As String Dim Shifts As Integer Dim brake As Integer Dim x As Integer Dim Version As String Dim MSP_name As String 'Set the file version Version = Year(Now()) & Month(Now()) & day(Now()) 'the file name will always have yyyymmdd version information on it. If however you want to allow many versions within the same day we can 'enabel the "timer" function which adds the number of seconds since midnight onto the end of this: 'Version = Year(Now()) & Month(Now()) & day(Now()) & "-" & Round(Timer(), 0) 'version control using time stamp Version = Format(Now, "yyyy-mmm-dd hh-mm-ss") 'get the MS Project file name to include in the excel name MSP_name = Left(ActiveProject.Name, Len(ActiveProject.Name) - 4) 'find the current project's path and set the file name for the excel file to be produced myFilePath = ActiveProject.Path myfilename = myFilePath & "\" & MSP_name & " " & Version & ".xlsx" 'myfilename = myFilePath & "\miles " & Version & ".xlsx" Set MyXL = CreateObject("Excel.Application") MyXL.Workbooks.Add 'MyXL.workbooks.Add.Name = "Exceptions.xlsx" MyXL.Visible = True MyXL.ActiveWorkbook.Worksheets.Add.Name = "Exception Report" MyXL.ActiveWorkbook.Worksheets("Exception Report").Activate Set xlrange = MyXL.ActiveSheet.Range("A1") 'set the page titles in Excel xlrange.Range("A1") = "Calendar Report : " & MSP_name xlrange.Range("A3") = "Individual Resource calendar exceptions" xlrange.Range("u3") = "Base Calendars" 'format page titles in Excel With xlrange.Range("A1:AL1") .Merge .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Interior.Color = RGB(198, 224, 180) .Font.Size = 24 .Font.Bold = True .RowHeight = .RowHeight * 2 End With With xlrange.Range("A3:s3") .Merge .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Interior.Color = RGB(198, 224, 180) .Font.Size = 16 .Font.Bold = True End With With xlrange.Range("u3:al3") .Merge .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Interior.Color = RGB(198, 224, 180) .Font.Size = 16 .Font.Bold = True End With With xlrange.Range("a5:al5") .Font.Bold = True End With With xlrange.Range("A2:AL2") .RowHeight = .RowHeight * 0.5 End With With xlrange.Range("A4:AL4") .RowHeight = .RowHeight * 0.5 End With 'set the titles in Excel xlrange.Range("A5") = "Resource Name" xlrange.Range("B5") = "Start Time" xlrange.Range("C5") = "Finish Time" xlrange.Range("d5") = "Name" xlrange.Range("e5") = "Holiday or working" xlrange.Range("f5") = "Base Calendar" xlrange.Range("g5") = " start" xlrange.Range("h5") = " end" xlrange.Range("i5") = "W/ hours" xlrange.Range("j5") = "Start 1" xlrange.Range("k5") = "finish 1" xlrange.Range("l5") = "Start 2" xlrange.Range("m5") = "Finish 2" xlrange.Range("n5") = "Start 3" xlrange.Range("o5") = "Finish 3" xlrange.Range("p5") = "Start 4" xlrange.Range("q5") = "Finsh 4" xlrange.Range("r5") = "Start 5" xlrange.Range("s5") = "Finish 5" xlrange.Range("u5") = "Base Calendar" xlrange.Range("v5") = "Name" xlrange.Range("w5") = "Start" xlrange.Range("x5") = "Finish" xlrange.Range("y5") = "Holiday or working" xlrange.Range("z5") = "start" xlrange.Range("aa5") = "End" xlrange.Range("ab5") = "W/ hours" xlrange.Range("ac5") = "Start 1" xlrange.Range("ad5") = "Finish 1" xlrange.Range("ae5") = "Start 2" xlrange.Range("af5") = "Finish 2" xlrange.Range("ag5") = "Start 3" xlrange.Range("ah5") = "Finish 4" xlrange.Range("ai5") = "Start 4" xlrange.Range("aj5") = "Finish 4" xlrange.Range("ak5") = "Start 5" xlrange.Range("al5") = "Finish 5" 'show exceptions to the standard base calendars row = 6 For Each C In ActiveProject.BaseCalendars N = N + 1 Debug.Print C 'Loop through every exception day within the base calendar If ActiveProject.BaseCalendars(N).Exceptions.Count > 0 Then For Each CalExcDay In ActiveProject.BaseCalendars(N).Exceptions 'If the exception isn't named, label it as "[Unnamed]" If CalExcDay.Name = "" Then CalExcDayName = "[Unnamed]" Else CalExcDayName = CalExcDay.Name End If 'identify if the exception is holiday or working time If CalExcDay.Shift1.Start = 0 Then xlrange.Range("y" & row) = "Holiday" Else xlrange.Range("y" & row) = "Working" End If 'display start and finish times 'Start time (if not holiday) If CalExcDay.Shift1.Start = 0 Then shift_start = "" Else shift_start = CalExcDay.Shift1.Start End If xlrange.Range("z" & row) = shift_start ' Finish time if not holiday If CalExcDay.Shift5.Finish <> 0 Then Shift_finish = CalExcDay.Shift5.Finish Shifts = 5 Else If CalExcDay.Shift4.Finish <> 0 Then Shift_finish = CalExcDay.Shift4.Finish Shifts = 4 Else If CalExcDay.Shift3.Finish <> 0 Then Shift_finish = CalExcDay.Shift3.Finish Shifts = 3 Else If CalExcDay.Shift2.Finish <> 0 Then Shift_finish = CalExcDay.Shift2.Finish Shifts = 2 Else If CalExcDay.Shift1.Finish <> 0 Then Shift_finish = CalExcDay.Shift1.Finish Shifts = 1 Else Shift_finish = "" End If End If End If End If End If xlrange.Range("aa" & row) = Shift_finish 'fill in the S1-F5 columsn xlrange.Range("ac" & row) = CalExcDay.Shift1.Start xlrange.Range("ad" & row) = CalExcDay.Shift1.Finish xlrange.Range("ae" & row) = CalExcDay.Shift2.Start xlrange.Range("af" & row) = CalExcDay.Shift2.Finish xlrange.Range("ag" & row) = CalExcDay.Shift3.Start xlrange.Range("ah" & row) = CalExcDay.Shift3.Finish xlrange.Range("ai" & row) = CalExcDay.Shift4.Start xlrange.Range("aj" & row) = CalExcDay.Shift4.Finish xlrange.Range("ak" & row) = CalExcDay.Shift5.Start xlrange.Range("al" & row) = CalExcDay.Shift5.Finish xlrange.Range("ab" & row) = "=(ad" & row & "-ac" & row & ")+(af" & row & "-ae" & row & ")+(ah" & row & "-ag" & row & ")+(aj" & row & "-ai" & row & ")+(al" & row & "-ak" & row & ")" 'output to excel columns xlrange.Range("u" & row) = C xlrange.Range("v" & row) = CalExcDay.Name xlrange.Range("w" & row) = CalExcDay.Start xlrange.Range("x" & row) = CalExcDay.Finish 'format to highlight working time exceptions If xlrange.Range("ab" & row) <> 0 Then xlrange.Range("u" & row & ":al" & row).Interior.Color = RGB(221, 235, 247) row = row + 1 Next CalExcDay Else 'i.e. no exceptions xlrange.Range("u" & row) = C xlrange.Range("v" & row) = "no exceptions" Debug.Print "no exceptions" row = row + 1 End If row = row + 1 ' inserts a space between base calendars Next C 'display each resource's exceptions i = 6 For Each r In ActiveProject.Resources If Not (r Is Nothing) Then ctr = 1 If r.Type = pjResourceTypeWork Then If r.Calendar.Exceptions.Count > 0 Then For Each E In r.Calendar.Exceptions xlrange.Range("A" & i) = r.Name xlrange.Range("b" & i) = r.Calendar.Exceptions.Item(ctr).Start xlrange.Range("c" & i) = r.Calendar.Exceptions.Item(ctr).Finish xlrange.Range("d" & i) = r.Calendar.Exceptions.Item(ctr).Name 'uses the fact that shfit1 sets the start time for any working, hence if blank/0 it is holiday If r.Calendar.Exceptions.Item(ctr).Shift1.Start = 0 Then xlrange.Range("e" & i) = "Holiday" Else: xlrange.Range("e" & i) = "Working" End If xlrange.Range("f" & i) = r.Calendar.BaseCalendar.Name 'find working time 'Start time (if not holiday) If r.Calendar.Exceptions.Item(ctr).Shift1.Start = 0 Then shift_start = "" Else shift_start = r.Calendar.Exceptions.Item(ctr).Shift1.Start End If xlrange.Range("g" & i) = shift_start ' Finish time if not holiday If r.Calendar.Exceptions.Item(ctr).Shift5.Finish <> 0 Then Shift_finish = r.Calendar.Exceptions.Item(ctr).Shift5.Finish Shifts = 5 Else If r.Calendar.Exceptions.Item(ctr).Shift4.Finish <> 0 Then Shift_finish = r.Calendar.Exceptions.Item(ctr).Shift4.Finish Shifts = 4 Else If r.Calendar.Exceptions.Item(ctr).Shift3.Finish <> 0 Then Shift_finish = r.Calendar.Exceptions.Item(ctr).Shift3.Finish Shifts = 3 Else If r.Calendar.Exceptions.Item(ctr).Shift2.Finish <> 0 Then Shift_finish = r.Calendar.Exceptions.Item(ctr).Shift2.Finish Shifts = 2 Else If r.Calendar.Exceptions.Item(ctr).Shift1.Finish <> 0 Then Shift_finish = r.Calendar.Exceptions.Item(ctr).Shift1.Finish Shifts = 1 Else Shift_finish = "" End If End If End If End If End If xlrange.Range("h" & i) = Shift_finish 'fill in the S1-F5 columsn xlrange.Range("j" & i) = r.Calendar.Exceptions.Item(ctr).Shift1.Start xlrange.Range("k" & i) = r.Calendar.Exceptions.Item(ctr).Shift1.Finish xlrange.Range("l" & i) = r.Calendar.Exceptions.Item(ctr).Shift2.Start xlrange.Range("m" & i) = r.Calendar.Exceptions.Item(ctr).Shift2.Finish xlrange.Range("n" & i) = r.Calendar.Exceptions.Item(ctr).Shift3.Start xlrange.Range("o" & i) = r.Calendar.Exceptions.Item(ctr).Shift3.Finish xlrange.Range("p" & i) = r.Calendar.Exceptions.Item(ctr).Shift4.Start xlrange.Range("q" & i) = r.Calendar.Exceptions.Item(ctr).Shift4.Finish xlrange.Range("r" & i) = r.Calendar.Exceptions.Item(ctr).Shift5.Start xlrange.Range("s" & i) = r.Calendar.Exceptions.Item(ctr).Shift5.Finish 'calculate the working hours xlrange.Range("i" & i) = "=(K" & i & "-J" & i & ")+(M" & i & "-L" & i & ")+(O" & i & "-N" & i & ")+(Q" & i & "-P" & i & ")+(S" & i & "-R" & i & ")" 'format to highlight working time exceptions If xlrange.Range("I" & i) <> 0 Then xlrange.Range("a" & i & ":s" & i).Interior.Color = RGB(221, 235, 247) ctr = ctr + 1 i = i + 1 Next End If End If End If Next r ' set conditional formatting for individual rows - holiday vs working 'autofit and collapse grouped columns With MyXL.ActiveWorkbook.Worksheets("Exception Report") .Columns("A:z").AutoFit .Columns("j:s").Columns.Group .Columns("ac:al").Columns.Group .Outline.ShowLevels ColumnLevels:=1 ' *' to collapse the columns End With ' xlrange.Range("A6").Select ' ActiveWindow.FreezePanes = True ' this isn't working for some reason 'MyXL.ActiveWorkbook.Worksheets("Exception Report").PageSetup.Orientation = xlLandscape ' commented out as this seems to crash the macro for some reason = maybe it's not seeing a printer installed? MyXL.ActiveWorkbook.SaveAs myfilename End SubThanks 🙂
Miles