Jan 04 2021 11:11 PM
Jan 05 2021 08:33 AM
If your VBA macro is attached to a specific file, I suggest you use the Organizer to transfer the module containing the macro to your Global. That will make it available to any Project you open or create. You can transfer the macro to other users by simply sending them the file, or a dummy file (e.g. one task), with the macro. I use that method when sending macros I create to someone.
As far as selling your code, that's a little more involved. The first thing to consider is what type of licensing agreement do you want. The second is, will your code be open-source. Third, how will you control configuration. If you want to truly make an add-in (i.e. closed-source), you need to re-create your macro in Visual Studio (or equivalent) so it is a separate entity.
Hope this helps.
John
Jan 05 2021 11:34 AM
Jan 05 2021 12:40 PM
Years ago I looked at licensing templates but in the end decided to write my own, but then my code is open-source so licensing is solely dependent on the integrity of users who pay the license fee. If you have something you did for Excel, you might consider using that.
And yes, open-source means anyone, with the right knowledge, can modify the code and do with it whatever they want.
I've never used Visual Studio myself, so I suggest you post a query in the Visual Studio forum, you'll likely find others who had similar questions.
Just curious, what exactly does your Project macro do?
Jan 05 2021 01:39 PM
Jan 05 2021 02:55 PM
Just for reference I wrote (or updated) a couple of macros that do the same thing and I "published" them on previous versions of this or other Project forums. The macros export Project and resource calendar exceptions data to Excel. Wanna give them a test run?
Jan 08 2021 03:42 AM - edited Jan 08 2021 03:42 AM
@John-project Sure - sounds like a good opportunity to see how someone else did it and learn more :) Thanks.
Jan 08 2021 09:10 AM
Take a look at this thread:
John
Jan 10 2021 06:35 AM
@John-project When I copy this into a new module in MSP Code I get an exception "Compile error: User-Defined type not defined" against the line DIM xlRng as Range which seems odd. Am I doing something wrong? I tried this in both my developement project file and a new project file...
Jan 10 2021 06:47 AM - edited Jan 10 2021 07:55 AM
@John-project whilst I didn't use the code in the example you posted I did build off some code you provided on a different thread 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
Jan 10 2021 09:09 AM
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.
Jan 11 2021 12:11 AM
@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 Sub
Thanks :)
Miles
Jan 11 2021 07:43 AM
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.
Jan 12 2021 08:29 AM
@John-project This does take a few seconds to run and finish the formatting however my actual product (SummaryPro) 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 :)