Hiding objects based on property of object

  • Thread starter Thread starter Bert
  • Start date Start date
B

Bert

I have a flowchart built out of a number of shapes in my Excel
worksheet. I want to write a macro to hide a number of objects based
on a shape property. For example, I want to hide all objects with a
certain transparency, or a certain color.

I am making a presenation and I want to hide portions of it at the
click of a mouse.

Any suggestions?

Thanks
 
Bert,
Not sure if Excel is the best for this. PowerPoint ?
Anyway something like this, with whatever your objects and properties are,
should get you started:

Private Sub CommandButton1_Click()
Dim Shapeobj As Shape

'Loop through all the shapes on the sheet
For Each Shapeobj In ThisWorkbook.ActiveSheet.Shapes
With Shapeobj
Select Case .AutoShapeType
'Decide which type of object tests which property for visibilty
Case msoShapeFlowchartDecision
.Visible = (.Width > 10)
Case msoShapeFlowchartConnector
.Visible = (.Height > 20)
'.
'.
'.

Case Else
.Visible = True
End Select
End With
Next

End Sub
 
Put a few rectangles and ovals on a sheet..
then try s'th like this:

Sub PeekaBoo(Visibility As Boolean, _
Optional ws As Worksheet, _
Optional ShapeType As MsoAutoShapeType = -1, _
Optional fTrans As Double = -1)
Dim sh As Shape

If ws Is Nothing Then Set ws = ActiveSheet

Application.ScreenUpdating = False

If ShapeType = -1 And fTrans = -1 Then
For Each sh In ws.Shapes
sh.Visible = Visibility
Next
ElseIf ShapeType = -1 Then
For Each sh In ws.Shapes
If Abs(sh.Fill.Transparency - fTrans) < 0.05 Then
sh.Visible = Visibility
End If
Next
ElseIf fTrans = -1 Then
For Each sh In ws.Shapes
If sh.AutoShapeType = ShapeType Then
sh.Visible = Visibility
End If
Next
Else
For Each sh In ws.Shapes
If Abs( _
sh.Fill.Transparency - fTrans) < 0.05 And _
sh.AutoShapeType = ShapeType Then
sh.Visible = Visibility
End If
Next
End If

Application.ScreenUpdating = True

End Sub

Sub Test()

Call PeekaBoo(True)
Call PeekaBoo(False, , , 0.3)
Application.Wait Now + TimeSerial(0, 0, 5)
Call PeekaBoo(True)
Call PeekaBoo(False, , msoShapeRectangle)
Application.Wait Now + TimeSerial(0, 0, 5)
Call PeekaBoo(True)
Call PeekaBoo(False, , msoShapeRectangle, 0.3)
Application.Wait Now + TimeSerial(0, 0, 5)
Call PeekaBoo(True)

End Sub



keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >
 
Back
Top