0

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.

Cindy Meister
  • 25,071
  • 21
  • 34
  • 43
act1292
  • 19
  • 6
  • Have you tried `.ScreenUpdating = False` – 0m3r May 06 '16 at 20:51
  • No - I need the screen to update since the VBA script is modifying shapes that are visible. Basically my VBA script is resizing object. – act1292 May 06 '16 at 20:57
  • Can you post your vba code? – 0m3r May 06 '16 at 20:59
  • But the user surely doesn't need to see all ongoing shape operations. So `Application.ScreenUpdating = False` at the begin of the sub and `Application.ScreenUpdating = True` at the end should be sufficient. – Mad Matts May 06 '16 at 21:01
  • It's quite complex - and large - and contains proprietary information. I'll try to write a simple sample that exhibits the problem and post it over the weekend. – act1292 May 06 '16 at 21:03
  • Application.ScreenUpdating isn't available in PowerPoint – act1292 May 06 '16 at 21:05
  • I see, been there ;) there are custom powerpoint screenupdating subs equivalent to `Application.Screenupdating` in Excel. Try this http://stackoverflow.com/a/28511767/6242846 – Mad Matts May 06 '16 at 21:11
  • http://skp.mvps.org/ppt00033.htm – 0m3r May 06 '16 at 21:50
  • Sorry - last post was not intended. I saw the subs but I'm not convinced suppressing screen updates is what I'm looking for. I want the user to be able to interact with the visible shapes - resizing them, etc. and these operations are controlled by the VBA code. – act1292 May 06 '16 at 23:17

0 Answers0