重附着引出序号

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