Sub Test() Dim s As Shape Dim col As New Collection Dim n As Long For Each s In ActivePage.FindShapes(Type:=cdrRectangleShape) col.Add s.StaticID s.URL.BookMark = "Rectangle" & s.StaticID Next s n = 1 For Each s In ActivePage.FindShapes(Type:=cdrEllipseShape) If n > col.Count Then Exit For s.URL.Address = "Rectangle" & col(n) s.URL.AltComment = "Link to the rectangle shape" n = n + 1 Next s End Sub