Dave,

One approach

Option Explicit

'---------------------------------------------------------------------------
Public Sub CFHighlight()
'---------------------------------------------------------------------------
Dim oShape As Shape
Dim cell As Range
Dim fc As Long
Dim dTop As Double
Dim dLeft As Double
Dim dWidth As Double
Dim dHeight As Double
Dim iTxtSize As Long
Dim iArea As Integer


With ActiveSheet
For Each oShape In .Shapes
If Left(oShape.Name, 9) = "CFPlus - " Then
oShape.Delete
End If
Next oShape

iArea = 0
For Each cell In .UsedRange

fc = 0
On Error Resume Next
fc = cell.FormatConditions(1).Type
On Error GoTo 0
If fc < 0 Then
dTop = cell.Top
dLeft = cell.Left
dWidth = cell.Width
dHeight = cell.Height
iTxtSize = CInt(Application.Min(36, Application.Max( _
Application.Min(dWidth /
2, dHeight / 30), 8)))

Set oShape =
..Shapes.AddTextbox(msoTextOrientationHorizontal, dLeft, _
dTop, dWidth, dHeight)
With oShape
.Name = "CFPlus - " & iArea
.Fill.ForeColor.SchemeColor = 13
.Fill.Transparency = 0.9
.OnAction = "CFHighlightShow"
With .TextFrame
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
If dWidth dHeight Then
.Orientation = msoTextOrientationHorizontal
Else
.Orientation = msoTextOrientationUpward
End If
.AutoSize = False
End With
With .Line
.Weight = 1#
.DashStyle = msoLineDash
.Style = msoLineSquareDot
.Transparency = 0#
.Visible = msoTrue
.ForeColor.SchemeColor = 54
.BackColor.RGB = RGB(255, 255, 255)
End With
With .TextFrame.Characters(1,
..TextFrame.Characters.Count).Font
.Name = "Arial"
.Size = iTxtSize
.Underline = xlUnderlineStyleNone
.ColorIndex = 34
End With
End With
iArea = iArea + 1
End If
Next cell
End With

'Clear variables
Set oShape = Nothing
End Sub


Sub CFHighlightShow()
MsgBox ActiveCell.Address
End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Dave Breitenbach" wrote in
message ...
Is there a way to show all conditional formats within a spreadsheet, maybe
in
a range of cells in a sheet?

tia,
Dave