ActivateNextShape

PowerPoint allows one to insert VBA controls on the slides but it doesn't provide any way to set focus on a particular VBA control. The ActivateShape() subroutine available enables you to do just that. Once the shape has focus, pressing the tab key doesn't move the focus to the next shape. For shapes that can capture the Tab key (the TextBox VBA control is one of those controls), the ActivateNextShape() subroutine can help set the focus to the next shape. Pass the currently focused VBA control shape as input to ActivateNextShape() and it will set the focus to the next control.

Download the example presentation from hereDownload to see ActivateShape(), ActivateNextShape() and ActivatePreviousShape() in action.

Notes:

  • ActivateNextShape() will set the focus to the next shape in the Z order (ZOrderPosition property).
  • ActivateNextShape() can work with any kind of ActiveX control in PowerPoint 97 and above.

See Also: ActivateShape(), ActivatePreviousShape()

Using ActivateNextShape():

The following example shows how to use ActivateNextShape(). It assumes that you have TextBox1 as a VBA TextBox control on Slide1. We write KeyUp handler for TextBox1 as follows:

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If (KeyCode = vbKeyTab) And (Shift = 0) Then
        ActivateNextShape Slide1.Shapes("TextBox1")
    End If
End Sub

Code for ActivateNextShape():


'
' Copyright (C) 2002 OfficeOne
'

Private Declare Sub keybd_event Lib "user32" ( _
    ByVal bVk As Byte, _
    ByVal bScan As Byte, _
    ByVal dwFlags As Long, _
    ByVal dwExtraInfo As Long)
Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" ( _
    ByVal wCode As Long, _
    ByVal wMapType As Long) As Long

Private Const VK_SHIFT = &H10&
Private Const KEYEVENTF_KEYUP = &H2&

Sub ActivateNextShape(ByVal CurrentShp As Shape)
    Dim Sld As Slide
    Dim Shp As Shape
    Dim CurrentZPosition As Long
    Dim NextShp As Shape
    Dim NextZPosition As Long

    Set Sld = CurrentShp.Parent

    CurrentZPosition = CurrentShp.ZOrderPosition
    NextZPosition = 2 ^ 31 - 1
    For Each Shp In Sld.Shapes
        If Shp.Type = msoOLEControlObject Then
            If (Shp.ZOrderPosition > CurrentZPosition) And _
                (NextZPosition > Shp.ZOrderPosition) Then
                Set NextShp = Shp
                NextZPosition = NextShp.ZOrderPosition
            End If
        End If
    Next

    If NextShp Is Nothing Then
        For Each Shp In Sld.Shapes
            If Shp.Type = msoOLEControlObject Then
                If (Shp.ZOrderPosition < CurrentZPosition) And _
                    (NextZPosition > Shp.ZOrderPosition) Then
                    Set NextShp = Shp
                    NextZPosition = NextShp.ZOrderPosition
                End If
            End If
        Next
    End If

    If Not (NextShp Is Nothing) Then
        ActivateShape NextShp
        keybd_event VK_SHIFT, MapVirtualKey(VK_SHIFT, 0), 0, 0
        keybd_event VK_SHIFT, MapVirtualKey(VK_SHIFT, 0), KEYEVENTF_KEYUP, 0
    End If
End Sub

Contact OfficeOne on email at officeone@officeoneonline.com. Copyright © 2001-2023 OfficeOne. All rights reserved.