MoveSelectedObjectsToNewLayers_Coreldraw_VBA

MoveSelectedObjectsToNewLayers

Sub MoveSelectedObjectsToNewLayers()
    Dim s As Shape
    Dim lr As Layer
    Dim p As Page
    Dim sr As ShapeRange
    
    ' Check if any object is selected
    If ActiveSelection.Shapes.Count = 0 Then
        MsgBox "Please select the images you want to split into layers first!", vbExclamation
        Exit Sub
    End If
    
    ActiveDocument.BeginCommandGroup "Move to New Layers"
    Set p = ActivePage
    Set sr = ActiveSelectionRange
    
    ' Loop through all selected objects
    For Each s In sr
        ' Create a new layer using the object/file name
        On Error Resume Next
        Set lr = p.CreateLayer(s.Name)
        On Error GoTo 0
        
        ' Move that object to the newly created layer
        s.MoveToLayer lr
    Next s
    
    ActiveDocument.EndCommandGroup
    MsgBox "Successfully moved objects to new layers based on file names!", vbInformation
End Sub