Auto Reattach Balloon

[dominiek_vanwest]

Hi,

I want to create a macro to Auto-Reattach the balloons.

I have the code as below but I get an error on oSelectset.Select(oBalloon). The error says 'Object doesn't support this property or method'.

What do I need to change in my code to make it work?

Thanks in advance!

Dominiek

Public Sub AutoReattachAnnotation()
    
    Dim odoc As Document
    Set odoc = ThisApplication.ActiveDocument
    
    If ThisApplication.Documents.Count = 0 Then
        MsgBox "A document must be open", vbExclamation
    Else
        If odoc.DocumentType <> kDrawingDocumentObject Then
            MsgBox "Must be in Drawing document", vbExclamation
        Else
            Dim oDrawDoc As DrawingDocument
            Set oDrawDoc = ThisApplication.ActiveDocument
            
            Dim oSheet As Sheet
            Set oSheet = oDrawDoc.ActiveSheet
                
            Dim oSelectset As SelectSet
            Set oSelectset = oDrawDoc.SelectSet
            oSelectset.Clear

            Dim oBalloon As Balloon
                          
            Dim i As Integer
            For i = 1 To oDrawDoc.ActiveSheet.Balloons.Count
                Set oBalloon = oDrawDoc.ActiveSheet.Balloons.Item(i)
                If oBalloon.Attached = False Then
                    oSelectset.Select (oBalloon)
                
                    Dim oControlDef As ControlDefinition
                    Set oControlDef = ThisApplication.CommandManager.ControlDefinitions.Item("DLxAnnoReconnectCmd")
                    Call oControlDef.Execute
                
                    oSelectset.Clear
                End If
            Next
        End If
    End If
    
End Sub

[dominiek_vanwest · Accepted solution]

I have found the solution myself.

I had to add 'Call'

Call oSelectset.Select (oBalloon)

[dominiek_vanwest · Accepted solution]

I have found an even faster way. My previous code would select a balloon and reattach it, select the next, reattach it,....

My new code selects all Balloons at once and reattaches them all at once.

Public Sub AutoReattachAnnotation()
    
    Dim odoc As Document
    Set odoc = ThisApplication.ActiveDocument
    
    If ThisApplication.Documents.Count = 0 Then
        MsgBox "A document must be open", vbExclamation
    Else
        If odoc.DocumentType <> kDrawingDocumentObject Then
            MsgBox "Must be in Drawing document", vbExclamation
        Else
            Dim oDrawDoc As DrawingDocument
            Set oDrawDoc = ThisApplication.ActiveDocument
                           
            Dim oSelectset As SelectSet
            Set oSelectset = oDrawDoc.SelectSet
            oSelectset.Clear
            
            Dim oBalloon As Balloon
            Dim aantal As Integer
            aantal = oDrawDoc.ActiveSheet.Balloons.Count
            
            Dim oTG As TransientObjects
            Set oTG = ThisApplication.TransientObjects
            Dim oBalloonCollection As ObjectCollection
            Set oBalloonCollection = oTG.CreateObjectCollection
                        
            Dim i As Integer
            For i = 1 To oDrawDoc.ActiveSheet.Balloons.Count
                Set oBalloon = oDrawDoc.ActiveSheet.Balloons.Item(i)
                Call oBalloonCollection.Add(oBalloon)
            Next
             
            Call oSelectset.SelectMultiple(oBalloonCollection)
            Call ThisApplication.CommandManager.ControlDefinitions.Item("DLxAnnoReconnectCmd").Execute
            oSelectset.Clear
            
        End If
    End If
    
End Sub