Copy paste of the shapes are not working

[harsha652]

Hi,

Visio is getting hanged while performing the below operation.

currentShape.Copy (Visio.VisCutCopyPasteCodes.visCopyPasteNoTranslate)
newPage.Paste (Visio.VisCutCopyPasteCodes.visCopyPasteNoTranslate)

[JuneTheSecond]

No reply?

Your macro works.

Try next.

Code Select Expand



Option Explicit

Sub test()

Dim currentShape As Visio.Shape
Dim newPage As Visio.Page

Set currentShape = ActivePage.Shapes(1)
Set newPage = ActiveDocument.Pages.Add
currentShape.Copy (Visio.VisCutCopyPasteCodes.visCopyPasteNoTranslate)
newPage.Paste (Visio.VisCutCopyPasteCodes.visCopyPasteNoTranslate)

End Sub