Hidden animations appear when running a VBA script - vba

Question

I have a powerpoint presentation that contains animations that show & hide shapes. In addition, there I have VBA scripts that run that will resize some of the same shapes. Whenever the VBA script is running, all of the shapes that were hidden using an animation appear and remain visible until the script finishes.
I could always change all of my animations to use VBA scripts instead to set the .Visible attribute of the shapes but this seems cumbersome and consumes a lot of code.
Is there any way to have VBA script an animations work together?
Thanks in advance
Here is the code:
Private Type MyIntegerPoint
x As Long
y As Long
End Type
Private Type MySinglePoint
x As Single
y As Single
End Type
Private Type MyRect
top As Single
left As Single
bottom As Single
right As Single
End Type
Option Explicit
Private Declare PtrSafe Function GetCursorPos Lib "User32" (lpPoint As MyIntegerPoint) As Long
Private Declare PtrSafe Function GetSystemMetrics Lib "User32" (ByVal nIndex As Long) As Long
Private Declare PtrSafe Function WindowFromPoint Lib "User32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare PtrSafe Function GetAsyncKeyState Lib "User32" (ByVal whichButton As Integer) As Integer
Public MousePt As MySinglePoint
Public StartPt As MySinglePoint
Public ShapeOrigCoord As MySinglePoint
Public InDrag As Boolean
Public Sub VerticalDragShape(ByRef sh As Shape)
If Not InDrag Then
InDrag = True
End If
' initialize drag variables
InitDragVars sh
ActivePresentation.SlideShowWindow.View.State = ppSlideShowPaused
While InDrag
GetScaledMousePt
DoEvents
Dim keyState As Integer
keyState = GetAsyncKeyState(1)
If keyState < 0 Then
InDrag = False
Else
With ActivePresentation.Windows(1).View.Slide
.Shapes("Shape1").top = MousePt.y
.Shapes("Shape1").left = MousePt.x
End With
End If
Wend
ActivePresentation.SlideShowWindow.View.State = ppSlideShowRunning
End Sub
Private Sub GetScaledMousePt()
Dim mPt As MyIntegerPoint
'Get the current raw mouse point
GetCursorPos mPt
'Convert it to point coordinates
MousePt.x = MouseXCoordToPoints(mPt.x)
MousePt.y = MouseYCoordToPoints(mPt.y)
End Sub
' converts an x screen coordinate into document window coordinates
' first, convert the screen pixels into slide show window coordinates
' second, convert slide show window coordinates to document window coordinates
Public Function MouseXCoordToPoints(x As Long) As Single
Dim slideWidth As Single
Dim screenWidth As Single
Dim fx As Single
fx = x
slideWidth = ActivePresentation.PageSetup.slideWidth
screenWidth = GetSystemMetrics(0)
MouseXCoordToPoints = fx * slideWidth / screenWidth
End Function
Public Function MouseYCoordToPoints(y As Long) As Single
' TRIAL 3
Dim slideHeight As Single
Dim screenHeight As Single
Dim fy As Single
fy = y
slideHeight = ActivePresentation.PageSetup.slideHeight
screenHeight = GetSystemMetrics(1)
MouseYCoordToPoints = fy * slideHeight / screenHeight
End Function
Private Sub InitDragVars(ByRef sh As Shape)
GetScaledMousePt ' scale current mouse point
StartPt = MousePt ' save start mouse point
ShapeOrigCoord.x = sh.left ' capture left coord of shape
ShapeOrigCoord.y = sh.top ' capture top coord of shape
End Sub
To exhibit the problem, create a single slide presentation that contains two shapes. Name the shapes in the presentation Shape1 & Shape2. Create an animation that hides Shape2 when placed in presentation mode. Insert an action on Shape1 to run VerticalDragShape when clicked on with the mouse. When you run the presentation, Shape2 should be hidden. Clicking (and releasing) the mouse on Shape1 should cause it to move with the mouse until you click again. However, when moving Shape1, Shape2 becomes visible again until the move operation is complete when it becomes hidden.