Object Model Reference : Classes : P : Page : Properties : Page.Properties |
Property Properties As Properties
Member of Page
The Properties property returns the Properties collection, which allows you to specify and manipulate custom data associated with a page.
The Properties property returns a read-only value.
The following VBA example creates 100 shapes and stores their IDs for future reference in the active page.
Sub CreateAndStoreShapes() |
Dim i As Long |
Dim x As Double, y As Double, r As Double |
Dim MaxX As Double, MaxY As Double, MaxR As Double |
Dim s As Shape, Num As Long |
MaxX = ActivePage.SizeWidth |
MaxY = ActivePage.SizeHeight |
MaxR = 1 |
Num = 100 |
' Store the total number of shapes |
ActivePage.Properties("ShapeArray", 0) = Num |
For i = 1 To Num |
x = Rnd() * MaxX |
y = Rnd() * MaxY |
r = Rnd() * MaxR |
Set s = ActiveLayer.CreateEllipse2(x, y, r) |
s.Fill.UniformColor.RGBAssign Rnd() * 256, Rnd() * 256, Rnd() * 256 |
' Store the current shape's ID number |
ActivePage.Properties("ShapeArray", i) = s.StaticID |
Next i |
End Sub |
The following VBA example retrieves all shape references stored in the page and deletes them.
Sub DeleteStoredShapes() |
Dim s As Shape, sr As New ShapeRange |
Dim v As Variant |
Dim Num As Long, i As Long, id As Long |
v = ActivePage.Properties("ShapeArray", 0) ' Retrieving the total number of shape references stored |
If Not IsNull(v) Then |
' Deleting the property |
ActivePage.Properties.Delete "ShapeArray", 0 |
Num = v |
ActiveDocument.ClearSelection |
For i = 1 To Num |
' Getting the current shape's ID to find |
id = ActivePage.Properties("ShapeArray", i) |
Set s = ActivePage.FindShape(StaticID:=id) |
' Add the shape to the shape range |
If Not s Is Nothing Then sr.Add s |
' Delete the property |
ActivePage.Properties.Delete "ShapeArray", i |
Next i |
sr.Delete ' Delete all shapes found |
Else |
MsgBox "No shape references are stored in the active page." |
End If |
End Sub |
Copyright 2013 Corel Corporation. All rights reserved.