'AfterDragDropOnSlide PPT event is not firing

I'm trying to write some macros for an animation addin, basically replicating the AfterEffects null object, allowing me to move and resize shapes on a PPT slide without selecting or grouping. I tag a shape as a "NULL" object, and I tag other shapes as "CHILD" objects, and I'm trying to "link" the two so that any change to a null object will filter down to the children.

The resizing part of this works great, with the aid of the AfterShapeSizeChange PPTEvent:

Private Sub PPTEvent_AfterShapeSizeChange(ByVal oShp As Shape)

Dim oChild As Shape
Dim oSld As Slide

Dim oldWidth As Single
Dim oldHeight As Single
Dim newWidth As Single
Dim newHeight As Single

Set oSld = oShp.Parent

If oShp.Tags("NULL") <> "" Then
    oldWidth = CSng(oShp.Tags("NULLWidth"))
    oldHeight = CSng(oShp.Tags("NULLHeight"))
    
    newWidth = oShp.width
    newHeight = oShp.height
    
    oShp.Tags.Add "NULLWidth", newWidth
    oShp.Tags.Add "NULLHeight", newHeight


    For Each oChild In oSld.Shapes
        If oChild.Tags("CHILD") <> "" Then
            If oChild.Tags("CHILD") = oShp.Name Then
                oChild.width = oChild.width * (newWidth / oldWidth)
                oChild.height = oChild.height * (newHeight / oldHeight)
            End If
        End If
    Next
End If

End Sub

So, every time I resize the null object, any children on the slide are scaled in proportion to the recent changes to the null object.

In theory, it would be a little easier to affect the position of the child shapes using the AfterDragDropOnSlide event. But I can't get it to fire when I run the following:

 Private Sub PPTEvent_AfterDragDropOnSlide(ByVal oSld As Slide, ByVal X As Single, ByVal Y As Single)

     MsgBox "Dragged afterdragdroponslide!"

 End Sub

Even in this simple example, the event never fires when I move any object around. Some googling around suggests this event is broken, but I'm unable to find any workaround. For example, I considered creating some kind of MouseUp event that checks to see if a null object is selected (and if so, if its position has changed, and if so, the macro would shift the position of any child shapes), but this doesn't seem to be possible.

Any thoughts would be much appreciated.



Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source