PDA

View Full Version : Conditional formating not working?



Astaroth
02-22-2008, 04:06 AM
I have written a VBA piece to export my Project into Excel. This program includes adding conditional formating to one of the columns.

The problem is that when running the macro the excel book is created fine but the conditional formating isnt applied. If you select the column and click conditional formating the formating is there and if you then click "ok" it then applies the formating but if you click cancel the formulas remain but the formating isnt applied.

the code relevant to this part is:

Set xlApp = New Excel.Application
xlApp.Visible = True
AppActivate "Microsoft Excel"

Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets.Add
xlSheet.Name = "Over View"
For Columns = 1 To (ColumnCount + 1)
Set xlCol = xlRow.Offset(0, Columns - 1)
xlCol = Columns - 1
Next Columns
rgt 2
xlCol = "Resource Name"
rgt 1
xlCol = "Start Date"
rgt 1
xlCol = "Finish Date"
rgt 1
xlCol = "RAG"
xlCol.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="R"
xlCol.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="A"
xlCol.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="G"
xlCol.FormatConditions(1).Interior.Color = RGB(255, 0, 0)
xlCol.FormatConditions(2).Interior.Color = RGB(255, 126, 0)
xlCol.FormatConditions(3).Interior.Color = RGB(0, 255, 0)
rgt 1
xlCol = "Complete"

rgt is simply a sub to move the column across by the integer

Many thanks

Bob Phillips
02-22-2008, 04:33 AM
That code doesn't even begin to run. You cannot use columns as a variable name, rgt1 and rgt2 aren't there, and xlRow isn't loaded.

In summary, nothing we can help with here.

Astaroth
02-22-2008, 04:41 AM
Ok, I have pasted the full code below, as I said, it was a snippet from it originally.

The code is working perfectly other than the conditional formating not applying unless you go into the excel document, select conditional formatting and click ok


Option Explicit
Dim xlRow As Excel.Range
Dim xlCol As Excel.Range
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

Sub ExportToExcel()
Dim Proj As Project
Dim t As Task
Dim Asgn As Assignment
Dim ColumnCount As Integer
Dim Columns As Integer
Dim Tcount As Integer
Dim r As Resource

Set xlApp = New Excel.Application
xlApp.Visible = True
AppActivate "Microsoft Excel"

Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets.Add
xlSheet.Name = "Over View"

'count columns needed

ColumnCount = 0
For Each t In ActiveProject.Tasks
If Not t Is Nothing Then
If t.OutlineLevel > ColumnCount Then
ColumnCount = t.OutlineLevel
End If
End If
Next t

'Set Range to write to first cell
Set xlRow = xlApp.ActiveCell
xlRow = "Filename: " & ActiveProject.Name
dwn 1
xlRow = "OutlineLevel"
dwn 1

'label Columns
For Columns = 1 To (ColumnCount + 1)
Set xlCol = xlRow.Offset(0, Columns - 1)
xlCol = Columns - 1
Next Columns
rgt 2
xlCol = "Resource Name"
rgt 1
xlCol = "Start Date"
rgt 1
xlCol = "Finish Date"
rgt 1
xlCol = "RAG"
xlCol.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="R"
xlCol.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="A"
xlCol.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="G"
xlCol.FormatConditions(1).Interior.Color = RGB(255, 0, 0)
xlCol.FormatConditions(2).Interior.Color = RGB(255, 126, 0)
xlCol.FormatConditions(3).Interior.Color = RGB(0, 255, 0)
rgt 1
xlCol = "Complete"
Tcount = 0


For Each t In ActiveProject.Tasks
If Not t Is Nothing Then
dwn 1
Set xlCol = xlRow.Offset(0, t.OutlineLevel)
xlCol = t.Name
If t.Summary Then
xlCol.Font.Bold = True
End If
For Each Asgn In t.Assignments
dwn 1
Set xlCol = xlRow.Offset(0, Columns)
xlCol = Asgn.ResourceName
rgt 1
xlCol = DateValue(Asgn.Start)
rgt 1
xlCol = DateValue(Asgn.Finish)
rgt 1
xlCol = t.Text1
rgt 1
If Asgn.PercentWorkComplete = 100 Then
xlCol = "True"
End If
Next Asgn
Tcount = Tcount + 1
End If
Next t
AppActivate "Microsoft Project"

MsgBox ("Macro Complete with " & Tcount & " Tasks Written")
End Sub

Sub dwn(i As Integer)
Set xlRow = xlRow.Offset(i, 0)
End Sub

Sub rgt(i As Integer)
Set xlCol = xlCol.Offset(0, i)
End Sub