VBA Powerpoint using Model3D : how to refreshing slide

Question

I'm using latest version of Powerpoint on Windows 10. I'm trying to rotate a 3d model with below code but its not refreshing the screen each time it does a IncrementRotationX Is there a special function call to get powerpoint to refresh/redraw the 3d object so that it smoothly shows the rotation on screen ? Any help would be appreciated.

Sub Program()

  Set myDocument = ActivePresentation.Slides(8)

    Dim x As Integer
    Dim y As Integer
    Dim z As Integer

  'Save current position
    x = ActivePresentation.Slides(8).Shapes("3D Model 3").Model3D.RotationX
    y = ActivePresentation.Slides(8).Shapes("3D Model 3").Model3D.RotationY
    z = ActivePresentation.Slides(8).Shapes("3D Model 3").Model3D.RotationZ

   MsgBox "RESET Position"

  For i = 1 To 45
  With myDocument
        .Shapes("3D Model 3").Model3D.IncrementRotationX (1)
        .Shapes("3D Model 3").Model3D.IncrementRotationY (1)
        .Shapes("3D Model 3").Model3D.IncrementRotationZ (1)
    End With
  Next i



   MsgBox "End of routine"

'reset position to starting point

   ActivePresentation.Slides(8).Shapes("3D Model 3").Model3D.RotationX = x
   ActivePresentation.Slides(8).Shapes("3D Model 3").Model3D.RotationY = y
   ActivePresentation.Slides(8).Shapes("3D Model 3").Model3D.RotationZ = z



  End Sub

I'm expecting my object to smoothly rotate in the powerpoint slide but it does not. It simply jolts to the last position; its not updating and refreshing to show it rotate as I "IncrementRotationX(1)"

Vityata · Answer 1 · 2019-08-22T12:36:22.183

For smooth rotation or animation, it is needed to wait some time between the loops. A possible way is to wait 1 second. (For waiting less than 1 second, see the solutions here - How to give a time delay of less than one second in excel vba?)

Thus, write Wait1Second within the loop:

  For i = 1 To 45
  With myDocument
        .Shapes("3D Model 3").Model3D.IncrementRotationX (1)
        .Shapes("3D Model 3").Model3D.IncrementRotationY (1)
        .Shapes("3D Model 3").Model3D.IncrementRotationZ (1)
  End With
  WaitASecond
  Next i

This is the sub Wait1Second():

Sub Wait1Second()
    Application.Wait (Now + #12:00:01 AM#)
End Sub

And this is a demo in Excel:

The code of the demo:

Option Explicit

Sub TestMe()

    Dim cnt As Long
    For cnt = 1 To 3
        Wait1Second
        WriteCircle 15, 1, 1
        Wait1Second
        WriteCircle 15, 1, 2
        Wait1Second
        WriteCircle 15, 2, 1
        Wait1Second
        WriteCircle 15, 2, 2
    Next cnt

End Sub

Sub WriteCircle(sizeX As Long, stepX As Long, stepY As Long)

    Dim sizeY As Long: sizeY = sizeX
    Dim y&, x&, r&, g&, b&
    Dim myCell As Range
    Worksheets(1).Cells.Clear

    For x = 1 To sizeX Step stepX
        For y = 1 To sizeY Step stepY
            With Worksheets(1)
                Set myCell = .Cells(x, y)

                If r >= 255 Then
                    If g >= 255 Then
                        b = b + 2
                    Else
                        g = g + 2
                    End If
                Else
                    r = r + 2
                End If
                myCell.Interior.Color = RGB(r, g, b)
            End With
        Next
    Next

End Sub

Thanks - however I want to ensure the animation smoothly (1 per sec is too slow) rotates as it does when I trigger the animation via the GUI. When I rotate using macro command it does not do this. — mars000, Aug 22 '19 at 03:40
@mars000 - see the link I have added for waiting less than a second. The old "animation laws" required 24 pics in second, thus waiting 42 miliseconds between cadres should be quite ok for smooth animation. — Vityata, Aug 22 '19 at 12:37

VBA Powerpoint using Model3D : how to refreshing slide

1 Answers1