[AccessD] Help with creating an Excel Conditional Format from within Access

David McAfee davidmcafee at gmail.com
Fri Jan 27 15:01:52 CST 2012


I have this stored procedure that I export into an excel sheet.
I'd like to add two conditional formats that highlight column M (light) red
(pink?) if the value is <0.
The other format would color column N Yellow if the value >.2 (20%)

I could do the coloring, but the user wants the conditional formatting
instead in case they play with the sheet's numbers.

Does anyone know how to do this off the top of their head?


Existing code:

Private Sub cmdExpExcel_Click()
    Dim strmySql As String, strOutPutFile As String, objXL As Object, row
As Integer
   On Error GoTo cmdExpExcel_Click_Error

    strmySql = ("EXEC RRMS.dbo.stpR6Payouts '" & Trim(Me.txtStart) & "','"
& Trim(Me.txtEnd) & "','" & Nz(Me.txtComp, "") & "'")
    strOutPutFile = Me.Application.CurrentProject.Path & "\Type6Payouts.xls"
    DoCmd.OutputTo acOutputStoredProcedure, strmySql, acFormatXLS,
strOutPutFile, False
    'Format the sheet
    Set objXL = CreateObject("Excel.Application")
    With objXL.Application
        .Visible = True
        .Workbooks.Open strOutPutFile
        .cells.EntireColumn.AutoFit

        .Worksheets("EXEC RRMS.dbo.stpR6Payouts '12_").Name = "R6Payouts"
        row = .CountA(.Worksheets("R6Payouts").Range("A:A"))
        With .Worksheets("R6Payouts").Range(.cells(2, 13).cells(row, 13))
            .Select
            .FormatConditions.Delete
            .FormatConditions.Add 'If cells in this range are <0 make the
cell's fill color light red
        End With
        With .Worksheets("R6Payouts").Range(.cells(2, 14).cells(row, 14))
            'If cells in this range are >.2 make the cell's fill color
YELLOW
        End With

    '    row = objXL.CountA(objXL.Worksheets("R6Payouts").Range("A:A"))
    '    With objXL.Worksheets("R6Payouts").Range(.Cells(1, 1), .Cells(row,
11))
    '        .Borders(7).LineStyle = 1 'xlEdgeLeft
    '        .Borders(8).LineStyle = 1 'xlEdgeTop
    '        .Borders(9).LineStyle = 1 'xlEdgeBottom
    '        .Borders(10).LineStyle = 1 'xlEdgeRight
    '        .Borders(11).LineStyle = 1 'xlInsideVertical
    '        .Borders(12).LineStyle = 1 'xlInsideHorizontal
    '    End With
    End With
Set objXL = Nothing

   On Error GoTo 0
   Exit Sub

cmdExpExcel_Click_Error:

    If Err.Number = 2302 Then
        MsgBox "R6Payout cannot be exported. It is possible that you
currently have the file open", vbOKOnly, "Can't export data"
    Else
        MsgBox "Error " & Err.Number & " (" & Err.description & ") in
procedure cmdExpExcel_Click of VBA Document Form_frmType6PayOutHdr"
    End If
End Sub


More information about the AccessD mailing list