ConvertMultipleToSymbols_VBA_Macros

Option Explicit

Sub ConvertMultipleToSymbols()
    Dim sel As ShapeRange
    Set sel = ActiveSelectionRange
    
    ' 1. Check if an Object is selected or not.
    If sel.Count = 0 Then
        MsgBox "Please select at least one Object or Bitmap!", vbExclamation, "Warning"
        Exit Sub
    End If
    
    ' Turn off Screen Refresh to make the Macro run faster
    Application.EventsEnabled = False
    Application.Optimization = True
    ActiveDocument.BeginCommandGroup "Convert Multiple To Symbols"
    
    On Error GoTo ErrorHandler
    
    Dim sh As Shape
    Dim counter As Long
    counter = 1
    
    ' 2. Run Loop on all Selected Objects/Bitmaps
    For Each sh In sel
        ' Create different Symbol names (for example: Symbol_1_160520, Symbol_2_160520...)
        Dim symbolName As String
        symbolName = "Symbol_" & counter & "_" & Format(Now, "hhmmss")
        
        ' Convert each Object to a Symbol
        sh.ConvertToSymbol symbolName
        
        counter = counter + 1
    Next sh

CleanUp:
    ActiveDocument.EndCommandGroup
    Application.EventsEnabled = True
    Application.Optimization = False
    ActiveWindow.Refresh
    Application.Refresh
    Exit Sub

ErrorHandler:
    MsgBox "A problem occurred:" & Err.Description, vbCritical, "Error"
    Resume CleanUp
End Sub