Threads in this forum
Related

VBA macro to paste each shape of a selection to new layers

Halp

I'm using CorelDRAW Graphics Suite 2024.

I want to paste 1 shape from a active selection on a newly created layer. I want to do that for each shape in the selection so that each shape ends up on separate new layer.

My previous attempt was with PasteEx(pasteopt), essentially STRG + C, STRG + V cause that's what a recorded macro would use. Then I found the ShapeRange method MoveToLayer in the CorelDRAW API documentation which seemed useful for what I'm trying to do and I remember reading that copy paste creates a lot of overhead and therefore is slower than CorelDRAW's native methods.

This is my current code:

Option Explicit
Sub DistrObjsToLyrs()

    Dim srOrigSelection As ShapeRange
    Set srOrigSelection = ActiveSelectionRange

    Dim i As Integer

    For i = 1 To srOrigSelection.Count

        ' Get shape name to pass on to "strLyrName"
        Dim strLyrName As String
        strLyrName = srOrigSelection.Shapes.Item(i).Name

        ' Create new layer "lrNewLyr" and pass the name saved on "strLyrName" to the new layer
        Dim lrNewLyr As Layer
        Set lrNewLyr = ActivePage.CreateLayer(strLyrName & i)
        
        ' Move all shapes in ShapeRange "srOrigSelection" to new layer "lrNewLyr"
        srOrigSelection.MoveToLayer (lrNewLyr)

        ' Remove current loops shape "i" from ShapeRange selection "srOrigSelection"
        srOrigSelection(i).RemoveFromSelection
            
    Next i
    
End Sub

The line "srOrigSelection(i).CopyToLayer (lrNewLyr)" always throws "Run-time error '438': Object doesn't support this property or method."

I've tried srOrigSelection(i).CopyToLayer (lrNewLyr) too, but that throws the same error. If I Debug or inspect lrNewLyr -> TreeNode -> Type it says "cdrLayerNode" in the locals window of the VBA editor which afaik is what the MoveToLayer/CopyToLayer functions expect?

I've also tried "srOrigSelection(i).CopyToLayer (lrNewLyr.Name)" but that throws a type missmatch.

Does anyone know what I'm doing wrong or if there is a more elegant solution?

  • 0

    I'm hoping this code will do the trick for you.

    It iterates through each shape in your selection.  If there is a layer that already has the name you're trying to create it uses that one, otherwise it creates a new layer.  Once the layer is created it moves the shape.

    I hope this helps.

    Option Explicit

    Sub MoveSlectedToLayers()
        Dim actSel As ShapeRange
        Dim workSh As Shape
        Dim workLayer As Layer
        Dim wkCount As Long
        
        Set actSel = ActiveDocument.SelectionRange
        
        If (actSel Is Nothing) Then
            ' No selection, nothing to do
            Exit Sub
        End If
        
        If (actSel.Count < 1) Then
            ' Somehow we have a selection with no objects.  Exit
            Exit Sub
        End If
        
        wkCount = 1
        
        ' This will catch the error if we try to set the workLayer (in the loop)
        ' and the layer doesn't already exist
        
        On Error Resume Next
        
        For Each workSh In actSel.Shapes
            ' If a layer already exists with the name we'll use it
            Set workLayer = ActivePage.Layers(workSh.Name & wkCount)
            
            If (workLayer Is Nothing) Then
                ' We couldn't find an existing layer so we'll create one
                Set workLayer = ActivePage.createLayer(workSh.Name & wkCount)
            End If
            
            workSh.MoveToLayer workLayer
            wkCount = wkCount + 1
            
            ' Clear our worklayer variable so it is ready for the next iteration
            Set workLayer = Nothing
        Next workSh
        
        MsgBox ("Move complete." & vbCr & wkCount - 1 & " objects moved.")
        
        
    End Sub

© Corel Corporation. All rights reserved. The content herein is in the form of a personal web log ("Blog") or forum posting. As such, the views expressed in this site are those of the participants and do not necessarily reflect the views of Corel Corporation, or its affiliates and their respective officers, directors, employees and agents. Terms of Use / Privacy​ ​/ ​Cookies / Terms and Conditions / User Guidelines.