Copy and Paste to New Doc

[John]

Hi there,

I'm having trouble copying and pasting from one document to another, based
on a custom property. The ideal will be to paste them vertically (ie
Shape1.PinX = 0mm, Shape2.PinX = 2mm, Shape3.PinX = 4mm...........etc.)

Can anyone set me on the right path?

Thanks

John



Sub CopyRabbitShapes()

Dim crntDoc As Visio.Document
Dim tempDoc As Visio.Document
Dim pag As Visio.Page
Dim shp As Visio.Shape

Set crntDoc = Application.ActiveDocument
Set tempDoc = Application.Documents.Add("")

For Each pag In crntDoc.Pages
For Each shp In pag.Shapes
If Not shp.CellExists("Prop.Type", Visio.visExistsAnywhere) = 0 Then
If shp.Cells("Prop.Type").ResultStr("") = "Rabbit" Then
'COPY THE SHAPE AND PASTE IT ONTO THE OPEN PAGE IN tempDoc
End If
End If
Next shp
Next pag

End Sub

 

[junethesecond]

I've uploaded a sort of copy-paste utility written in VBA at,
http://www.geocities.com/piping_isometrics/Down/CopyPaste.zip
, how to use is located here,
http://www.geocities.com/piping_isometrics/English/Visio_Copy_Paste.htm

This utility also enables you to paste multi-times with a constant x and y
pitch.
You can take any part for your code.

 

[John]

Thanks for this June. This will come in very handy.

Best regards

John