Need help with iteration in TimeScaleData

[Juan]

Hi again,

I use the TimeScaleData in an Excelsheet in order to import some values from
MS Project.
I've been trying to think of the iteration that may let me import these
values half-monthly, but since im a relative beginner with VBA, this is
turning to be a little bit too difficult for me.
Since i want to get "work" and "cost" for the periods 1st to 15th and 16th
to end of the month, im doing using "day" as unit for the timescaled import.
But regarding to the loop that should allow me to add the daily values
according to my periods Ive made no progress.

I would be very grateful if someone could help me with this.
Im posting the code im using.
....
viewapply (mApp.ActiveProject.ViewList(3))
Set xlcell = Range("A2")
For r = 1 To mApp.ActiveProject.Resources.Count
If Not mApp.ActiveProject.Resources.Item(r) Is Nothing Then
If mApp.ActiveProject.Resources.Item(r).Type = 0 Then
' pjResourceTypeWork
xlcell.Value =
mApp.ActiveProject.Resources.Item(r).Name
Set xlcell = xlcell.Offset(1, 0) 'step down 1 row
ElseIf mApp.ActiveProject.Resources.Item(r).Type = 1 Then
xlcell.Value =
mApp.ActiveProject.Resources.Item(r).Name
Set xlcell = xlcell.Offset(1, 0)
End If
End If
Next
sdatum = ActiveSheet.Range("B24").Value
edatum = ActiveSheet.Range("B25").Value
AnzInt = DateDiff("m", sdatum, edatum) + 1
'ActiveSheet.Range("RangeRessourcen").Select
'Set RR = ActiveSheet.Range("RangeRessourcen")
'RR.Select
For Each c In ActiveSheet.Range("RangeRessourcen")
ResName = Cells(c.Row, 2).Value
If ResName <> "" Then
For r = 1 To mApp.ActiveProject.Resources.Count
If Not mApp.ActiveProject.Resources.Item(r) Is
Nothing Then
If mApp.ActiveProject.Resources.Item(r).Name =
ResName Then
Application.Caption = "Datensatz" & r
Application.Cells(c.Row, 2).Value =
(mApp.ActiveProject.Resources(r).Cost) * 1
Application.Cells(c.Row, 3).Value =
(mApp.ActiveProject.Resources(r).Work / 60) * 1
For x = 1 To AnzInt
Set tsv =
mApp.ActiveProject.Resources(r).TimeScaleData(sdatum, edatum, Type:=13,
TimescaleUnit:=4)
strValue = Val(tsv(x).Value) / 60
ITERATION...
Next x
End If
End If
Next r
Set tsv = Nothing
End If
Next

 

[Jack Dahlgren]

Juan,

Not sure what you are doing with the sdatum and edatum and AnzInt, but it
looks confusing.
Here is what I would do.

Use a variable for the day that you are going to retrieve data for. example
myDate
Use a variable to sum the work and cost - example myWork, myCost
Set a lower and upper value for it (perhaps project start and project
finish.
Use it as the outermost loop.
Within this loop find the month of the variable -
myMonth = month(myDate)

Store that value in another variable.
Find the number of the date
day(myDate)

Use some conditional logic to find out whether you are in the first part of
the month or the second -
if day(myDate) < 16 then
'add the value to myCost and myWork
go to next myDate
When you finish this loop, write the value to excel

If you are in the second part of the month then you know that
day(myDate) is greater than 15 so keep adding the values until the month
changes.
while month(myDate) = myMonth
myCost = myCost + '(timescaled data for myDate)
When you exit this loop write the value to excel.

There are probably other ways to manage the looping, but this is just what I
come up with while thinking about it.

-Jack Dahlgren

 

[Juan]

Hi, Jack,

first thank you very much for your advices.

In spite of youre explanation, I must confess that I dont get it.
I've tried to do as you say in your reply, looping myDate, but im not
reaching to manage it. I think i must have missunderstood some point about
TimeScaleData, but its not getting clearer with the Microsoft VB Help.
It may be expecting too much, but i would be eternally grateful if you
showed me some example.

Thanks again.
Best regards,

Juan.

 

[Jack Dahlgren]

Here is some code snipped from my website which writes out the data on daily
basis:

Set TSV = r.TimeScaleData(tbStart.Value, tbEnd.Value,
_ TimescaleUnit:=pjTimescaleDays)
'loop through all timescale data and write to cells
For i = 1 To TSV.Count
xlRange.Value = TSV(i).Value / (60 * ActiveProject.HoursPerDay)
'move to next excel cell


source:
http://zo-d.com/blog/archives/progr...oft-project-resource-usage-data-in-excel.html


What you need to do with this is to sum up the values for the half months.
To do this you need to know what date is associated with each piece of
timescaled data. You can do this by setting a TSV for each day and grouping
them or you can probably modify the above code. To work with the one above
you need to construct two loops, one which sums data from the first part of
the month and one which sums the data from the second part of the month.

I'm not going to write all the code and test it, but here is roughly how it
would go:

dim sDate as Date
sDate = activeproject.Start
dim iDate as Date
iDate = sDate
dim firstHalf as boolean
firstHalf = false
dim workSum as long
worksum = 0
if day(iDate) < 16 then
firstHalf = True
end if
Set TSV = r.TimeScaleData(activeproject.start, activeproject.finish,
_ TimescaleUnit:=pjTimescaleDays)
'loop through all timescale data and write to cells
For i = 1 To TSV.Count

if firsthalf then
worksum = worksum + TSV(i).value
iDate = sDate + i
if day(iDate) > 15 then
firstHalf = False
end if
if day(iDate) = 15 then
'write worksum to excel
worksum = 0
end if
end if

if not firsthalf then
worksum = worksum + TSV(i).value
iDate = sDate + i
if day(iDate) < 16 then
firstHalf = True
end if
if day(iDate+1) = 1 then
'write worksum to excel
worksum = 0
end if
end if


You need to test to make sure I got the dates right to capture the correct
boundries, but it should work

-Jack

 

[Juan]

Hello, Jack,

thanks a lot for your help!
I'm quite sure I wouldn't have been able to do it on my own.
Now it works pretty well.

Thanks again.
Best regards,

Juan

 

[Jack Dahlgren]

Glad I could help. Do you mind posting the code you came up with so that it
might help someone else in the future?

-Jack Dahlgren

 

[Juan]

Of course.
Here i go:

Private Sub CmdImportRes_Click()
Dim Datei As String
Dim pfad
Dim r As Integer
Dim mApp As MSProject.Application
Dim proj As MSProject.Project
Dim xlcell As Range
Dim xlCost As Range, xlWork As Range, dias As Range
Dim found As Boolean
Dim ResName As String
Dim c As Range
Dim i As Integer, AnzInt As Integer
Dim strValue As String
Dim tsCost As Object, tsWork As Object
Dim sDatum As Date, eDatum As Date
Dim iDatum As Date
Dim firstHalf As Boolean
Dim sumCost As Long, sumWork As Long

firstHalf = False
sumCost = 0
'sumWork = 0

pfad = Application.GetOpenFilename("Microsoft Project Datei (*.mpp),
*.mpp")
If pfad = False Then
MsgBox "Keine Datei wurde ausgewählt."
Exit Sub
Else
Datei = Mid$(pfad, InStrRev(pfad, "\") + 1)
Datei = Left(Datei, Len(Datei) - 4)
MsgBox Datei & vbCrLf & pfad, vbInformation
End If

Set mApp = New MSProject.Application
found = False
If mApp.Visible = True Then
If mApp.Projects.Count > 0 Then
For Each proj In mApp.Projects
If proj.Name = Datei Then
found = True
proj.Activate
End If
Next
End If
End If

If found = True Then
mApp.Visible = False

'viewapply (mApp.ActiveProject.ViewList(3))
Set xlcell = Range("A2")
For r = 1 To mApp.ActiveProject.Resources.Count
If Not mApp.ActiveProject.Resources.Item(r) Is Nothing Then
If mApp.ActiveProject.Resources.Item(r).Type = 0 Then
' pjResourceTypeWork
xlcell.Value =
mApp.ActiveProject.Resources.Item(r).Name
Set xlcell = xlcell.Offset(1, 0)
ElseIf mApp.ActiveProject.Resources.Item(r).Type = 1 Then
xlcell.Value =
mApp.ActiveProject.Resources.Item(r).Name
Set xlcell = xlcell.Offset(1, 0)
End If
End If
Next
sDatum = ActiveSheet.Range("A16").Value
eDatum = ActiveSheet.Range("A17").Value
For Each c In ActiveSheet.Range("RangeRessourcen")
ResName = Cells(c.Row, 1).Value
If ResName <> "" Then
For r = 1 To mApp.ActiveProject.Resources.Count
If Not mApp.ActiveProject.Resources.Item(r) Is
Nothing Then
If mApp.ActiveProject.Resources.Item(r).Name =
ResName Then
Application.Caption = "Datensatz" & r
Application.Cells(c.Row, 2).Value =
(mApp.ActiveProject.Resources(r).Cost) * 1
Application.Cells(c.Row, 3).Value =
(mApp.ActiveProject.Resources(r).Work / 60) * 1
iDatum = sDatum
'Set tsCost =
mApp.ActiveProject.Resources(r).TimeScaleData(sDatum, eDatum, Type:=12,
TimescaleUnit:=4)
Set tsWork =
mApp.ActiveProject.Resources(r).TimeScaleData(sDatum, eDatum + 1, Type:=13,
TimescaleUnit:=4)
'Set xlCost = Application.Cells(c.Row, 4)
Set xlWork = Application.Cells(c.Row, 4)
For i = 1 To tsWork.Count
'sumCost = sumCost + Val(tsCost(i).Value)
sumWork = sumWork + Val(tsWork(i).Value)
/ 60
If iDatum = eDatum Then
'xlCost.Value = sumCost
xlWork.Value = sumWork
'sumCost = 0
sumWork = 0
Exit For
End If
If Day(iDatum + 1) = 16 Or Day(iDatum +
1) = 1 Then
'xlCost.Value = sumCost
'Set xlCost = xlCost.Offset(0, 1)
xlWork.Value = sumWork
Set xlWork = xlWork.Offset(0, 1)
'sumCost = 0
sumWork = 0
End If
iDatum = iDatum + 1
Next i
End If
End If
Next r
'Set tsCost = Nothing
Set tsWork = Nothing
'Set xlCost = Nothing
Set xlWork = Nothing
End If
Next
Application.Cells(1, 1).Select


ElseIf found = False Then
'Set mApp = New MSProject.Application
mApp.Visible = False
mApp.FileOpen pfad

'viewapply (mApp.ActiveProject.ViewList(3))
Set xlcell = Range("A2")
For r = 1 To mApp.ActiveProject.Resources.Count
If Not mApp.ActiveProject.Resources.Item(r) Is Nothing Then
If mApp.ActiveProject.Resources.Item(r).Type = 0 Then
' pjResourceTypeWork
xlcell.Value =
mApp.ActiveProject.Resources.Item(r).Name
Set xlcell = xlcell.Offset(1, 0)
ElseIf mApp.ActiveProject.Resources.Item(r).Type = 1 Then
xlcell.Value =
mApp.ActiveProject.Resources.Item(r).Name
Set xlcell = xlcell.Offset(1, 0)
End If
End If
Next
sDatum = ActiveSheet.Range("A16").Value
eDatum = ActiveSheet.Range("A17").Value
For Each c In ActiveSheet.Range("RangeRessourcen")
ResName = Cells(c.Row, 1).Value
If ResName <> "" Then
For r = 1 To mApp.ActiveProject.Resources.Count
------------ THE SAME AGAIN ------------
Next r
'Set tsCost = Nothing
Set tsWork = Nothing
'Set xlCost = Nothing
Set xlWork = Nothing
End If
Next
Application.Cells(1, 1).Select
mApp.FileClose pjDoNotSave

End If


'mpApp.Quit
Set mApp = Nothing
'Set objSheet = Nothing
Set xlcell = Nothing

'AppActivate "Microsoft Excel"
'Application.ActiveWorkbook.Worksheets(1).Activate
Range("A1").Select
'Sheets(3).Range("CB20").Select

End Sub

By the way, Im using the part of the code at the beginning, which takes the
name of the file and its path and checks whether the file is running or not,
in some other buttons of the same xlbook as well. Would you write this part
separately in a modul?

Glad to contribute.
Best regards,
Juan.