Macro Expert's

[Marinhogn]

Hello all,

I'm having a BIg problem with the following macro. Its a exporting timescale
resource data that i'm try to build....I've made a form to Define time
interval for timephased data..... Please advise...


Private Sub btnExport_Click()
exportResourceUsage
End Sub

Sub exportResourceUsage()

Dim Pj As Project
Dim R As Resources
Dim XlApp As Excel.Application
Dim IdSheet As Integer

Set Pj = ActiveProject
Set PjRes = Pj.Resources

Dim i As Long, j As Long
Dim xlRange As Excel.Range
Dim xlCol As Excel.Range
Dim xlRow As Excel.Range


'open excel and set the curson at the upper left cell
Set XlApp = New Excel.Application
XlApp.Visible = True
AppActivate "Microsoft Excel"
Set XlBook = XlApp.Workbooks.Add
Set XlSheet = XlBook.Worksheets.Add
XlSheet.Name = "MS Excel"
Set xlRange = XlApp.ActiveSheet.Range("A1:A1")

Dim TSVActualWork As TimeScaleValues
Dim TSVCost As TimeScaleValues
Dim T As Long
Dim H As Long
Dim Row As Integer

Set rs = ActiveProject.Resources
For Each R In rs
If Not R Is Nothing Then
xlRange.Value = R.Name
Set xlRange = xlRange.Offset(0, 1)
If R.EnterpriseGeneric Then
xlRange.Value = R.EnterpriseGeneric
End If

Set TSV = R.TimeScaleData(tbStart.Value, tbEnd.Value,
TimescaleUnit:=cboxTSUnits.Value)
'loop through all timescale data and write to cells
For i = 1 To TSV.Count

Select Case cboxTSUnits.Value
Case 0 'years
xlRange.Value = TSV(i).Value / (60 * ActiveProject.HoursPerDay *
ActiveProject.DaysPerMonth * 12)

Case 1 'quarters
xlRange.Value = TSV(i).Value / (60 * ActiveProject.HoursPerDay *
ActiveProject.DaysPerMonth * 3)

Case 20 'months
xlRange.Value = TSV(i).Value / (60 * ActiveProject.HoursPerDay *
ActiveProject.DaysPerMonth)

Case 3 'weeks
xlRange.Value = TSV(i).Value / (60 * ActiveProject.HoursPerWeek)

Case 4 'days
xlRange.Value = TSV(i).Value / (60 * ActiveProject.HoursPerDay)

End Select

Set xlRange = xlRange.Offset(0, 1)
Next i

Set xlRange = xlRange.Offset(1, -(TSV.Count + 2))

'some minor excel formatting of results
XlApp.Rows("1:1").Select
XlApp.Selection.NumberFormat = "m/d/yy;@"
XlApp.Cells.Select
XlApp.Cells.EntireColumn.AutoFit

' Set up currency format for Excel
CurrencyFormat = SetCurrencyFormat(Pj)

If Pj.Resources.Count > 0 Then

XlSheet.Cells(1, 1) = “Groupâ€
XlSheet.Cells(1, 2) = “Resourceâ€
XlSheet.Cells(1, 3) = “Dateâ€
XlSheet.Cells(1, 4) = “Actual_Workâ€
XlSheet.Cells(1, 5) = “Costâ€
XlSheet.Cells(1, 6) = “Workâ€

Row = 2

For H = 1 To Pj.Resources.Count
Set TSVActualWork = PjRes(R).TimeScaleData(Start, Finish, _
Type:=pjResourceTimescaledActualWork,
TimescaleUnit:=TimescaleUnit)
Set TSVCost = PjRes(R).TimeScaleData(Start, Finish, _
Type:=pjResourceTimescaledCost, TimescaleUnit:=TimescaleUnit)
Set TSVWork = PjRes(R).TimeScaleData(Start, Finish, _
Type:=pjResourceTimescaledWork, TimescaleUnit:=TimescaleUnit)

For T = 1 To TSVActualWork.Count

If Not TSVActualWork(T).Value = ҠAnd Not TSVCost(T).Value = “â€
Then
XlSheet.Cells(Row, 1) = PjRes(R).Group
XlSheet.Cells(Row, 2) = PjRes(R).Name
XlSheet.Cells(Row, 3) = TSVActualWork(T).StartDate
XlSheet.Cells(Row, 6) = TSVWork(T).StartDate
Select Case TimeUnits
Case pjTimescaleMonths
XlSheet.Cells(Row, 3).NumberFormat = "Mmm Yy"
End Select

If Not TSVActualWork(T).Value = ҠThen
XlSheet.Cells(Row, 4) = TSVActualWork(T).Value / d
XlSheet.Cells(Row, 4).NumberFormat = "#,##0"
XlSheet.Cells(Row, 6) = TSVWork(T).Value / d
XlSheet.Cells(Row, 6).NumberFormat = "#,##0"

End If
If Not TSVCost(T).Value = ҠThen
XlSheet.Cells(Row, 5) = TSVCost(T).Value
XlSheet.Cells(Row, 5).NumberFormat = "#,##0"
End If

Row = Row + 1

End If

Next T
Next H

End If

XlApp.ScreenUpdating = True
MSProject.ScreenUpdating = True
'and finally display a message that we are finished
AppActivate "Microsoft Project"

XlApp.Visible = True
AppActivate "Microsoft Excel"
End Sub

Function SetCurrencyFormat(Pj As Project)

' Set currency number format
CurrencyFormat = “â€

Select Case Pj.CurrencySymbolPosition
Case pjBefore
CurrencyFormat = """" & Pj.CurrencySymbol & """"""
Case pjBeforeWithSpace
CurrencyFormat = "â€"" & Pj.CurrencySymbol & """" & †â€"
End Select

CurrencyFormat = CurrencyFormat & "#,##0"

If ActiveProject.CurrencyDigits > 0 Then
CurrencyFormat = CurrencyFormat & "."
For i = 1 To Pj.CurrencyDigits
CurrencyFormat = CurrencyFormat & "0"
Next i
End If

Select Case Pj.CurrencySymbolPosition
Case pjAfter
CurrencyFormat = CurrencyFormat & "â€"" & Pj.CurrencySymbol & “â€"""
Case pjAfterWithSpace
CurrencyFormat = CurrencyFormat & " †& “â€"" & Pj.CurrencySymbol
& “â€"""
End Select

SetCurrencyFormat = CurrencyFormat

End Function
Private Sub Label3_Click()

End Sub

Private Sub UserForm_Initialize()
tbStart = ActiveProject.ProjectStart
tbEnd = ActiveProject.ProjectFinish
fillFTEBox
fillTSUnitsBox
End Sub
Sub fillFTEBox()
'sets choice of FTE or Hours
cboxFTE.List = Array("Horas", "FTE")
cboxFTE.Value = "Horas"
End Sub
Sub fillTSUnitsBox()
'sets Units constants
Dim myArray(5, 2) As String
myArray(0, 0) = "Dias"
myArray(0, 1) = pjTimescaleDays
myArray(1, 0) = "Semanas"
myArray(1, 1) = pjTimescaleWeeks
myArray(2, 0) = "Mês"
myArray(2, 1) = pjTimescaleMonths
myArray(3, 0) = "Trimestres"
myArray(3, 1) = pjTimescaleQuarters
myArray(4, 0) = "Ano"
myArray(4, 1) = pjTimescaleYears

cboxTSUnits.List = myArray
'use weeks as default value
cboxTSUnits.Value = 3
End Sub



Thanks in advance

 

[Rod Gill]

So what's the problem? There's a lot of code, so please narrow down your
problem. Firstly you need to resolve some variable names. EG use

for each R in activeproject.resources

Dim tsv as timescalevalue

Start again with your R.Timescalevalue code. To begin with, ignore the user
form and just get it working with a fixed start and finish date and units.
for each tsv in TSVActualWork

next tsv

--

Rod Gill
Microsoft MVP for Project

Author of the only book on Project VBA, see:
http://www.projectvbabook.com