Hello Plettieri,
On 22 October 02, you posted a question regarding printing a range with validation circles.
http://216.92.17.166/board/viewtopic.php?topic=26183&forum=2
I was cruising around the Microsoft Knowledge Base (as one does on a Sunday morning), and came across the following macros. They may be useful to you (or have I missed the point again?).
Procedure I adopted to get the "Print Validation Circles" macro to work:
1 Enter list of data to validate
2 Go to Data menu/Validation
3 In the "Allow" drop-down, select a criteria e.g.
Whole Number
Between
Minimum = 5
Maximum = 50
4 Run the Validation Circles macro
<pre>
Sub AddValidationCirclesForPrinting()
' http://support.microsoft.com/default.aspx?scid=KB;EN-US;Q190246&
'Macro to Create Data Validation Circles for Printing
Dim DataRange As Range
Dim c As Range
Dim count As Integer
Dim o As Shape
' Set an object variable to all of the cells on the active
' sheet that have data validation -- if an error occurs, run
' the error handler and end the procedure
On Error GoTo errhandler
Set DataRange = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo 0
count = 0
' Loop through each cell that has data validation
For Each c In DataRange
' If the validation value for the cell is false, then draw
' a circle around the cell. Set the circle's fill to
' invisible, the line color to red and the line weight to
' 1.25
If Not c.Validation.Value Then
Set o = ActiveSheet.Shapes.AddShape(msoShapeOval, _
c.Left - 2, c.Top - 2, c.Width + 4, c.Height + 4)
o.Fill.Visible = msoFalse
o.Line.ForeColor.SchemeColor = 10
o.Line.Weight = 1.25
' Change the name of the shape to InvalidData_ + count
count = count + 1
o.Name = "InvalidData_" & count
End If
Next
Exit Sub
errhandler:
MsgBox "There are no cells with data validation on this sheet."
End Sub
Sub RemoveValidationCircles()
Dim shp As Shape
' Remove each shape on the active sheet that has a name starting
' with InvalidData_
For Each shp In ActiveSheet.Shapes
If shp.Name Like "InvalidData_*" Then shp.Delete
Next
End Sub
</pre>
Regards,
Mike
On 22 October 02, you posted a question regarding printing a range with validation circles.
http://216.92.17.166/board/viewtopic.php?topic=26183&forum=2
I was cruising around the Microsoft Knowledge Base (as one does on a Sunday morning), and came across the following macros. They may be useful to you (or have I missed the point again?).
Procedure I adopted to get the "Print Validation Circles" macro to work:
1 Enter list of data to validate
2 Go to Data menu/Validation
3 In the "Allow" drop-down, select a criteria e.g.
Whole Number
Between
Minimum = 5
Maximum = 50
4 Run the Validation Circles macro
<pre>
Sub AddValidationCirclesForPrinting()
' http://support.microsoft.com/default.aspx?scid=KB;EN-US;Q190246&
'Macro to Create Data Validation Circles for Printing
Dim DataRange As Range
Dim c As Range
Dim count As Integer
Dim o As Shape
' Set an object variable to all of the cells on the active
' sheet that have data validation -- if an error occurs, run
' the error handler and end the procedure
On Error GoTo errhandler
Set DataRange = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo 0
count = 0
' Loop through each cell that has data validation
For Each c In DataRange
' If the validation value for the cell is false, then draw
' a circle around the cell. Set the circle's fill to
' invisible, the line color to red and the line weight to
' 1.25
If Not c.Validation.Value Then
Set o = ActiveSheet.Shapes.AddShape(msoShapeOval, _
c.Left - 2, c.Top - 2, c.Width + 4, c.Height + 4)
o.Fill.Visible = msoFalse
o.Line.ForeColor.SchemeColor = 10
o.Line.Weight = 1.25
' Change the name of the shape to InvalidData_ + count
count = count + 1
o.Name = "InvalidData_" & count
End If
Next
Exit Sub
errhandler:
MsgBox "There are no cells with data validation on this sheet."
End Sub
Sub RemoveValidationCircles()
Dim shp As Shape
' Remove each shape on the active sheet that has a name starting
' with InvalidData_
For Each shp In ActiveSheet.Shapes
If shp.Name Like "InvalidData_*" Then shp.Delete
Next
End Sub
</pre>
Regards,
Mike