Lock button in Powerpoint Custom Ribbon

[emranali1989]

Problem: I have a lock button (toggle button) on my custom ribbon. Basically "lock and unlock" the "Aspect ratio" of the text box.
Also i wanted few points to cover while preparing it - -

• I wanted to run the event on powerpoint, whenever I select the single or multiple text boxes/shape/image, if its aspect ratio is already locked then my "Lock" button need to highlight in the ribbon. vice versa
• If I select multiple text boxes/shape/images with few's aspect ratio are lock and few's aspect ratio are unlock, then it must unhighlight the "lock" button in the ribbon.

I am just unclear what to write in the event. pls help


XML Code:
<customUI onLoad="RibbonUI_onLoad1" xmlns="http://schemas.microsoft.com/office/2009/07/customui">
<ribbon startFromScratch="false">
<tabs>
<tab id="customTab" label="WIP">
<group id="customGroup3" label="Organize">
<toggleButton id="MyToggleButton1" label="Lock" size="normal" imageMso="LockCell" onAction="Lock_and_Unlock" getPressed="GetPressed" />
</group>
</tab>
</tabs>
</ribbon>
</customUI>


Code on Module:
'Callback for MyToggleButton1 onAction
Sub Lock_and_Unlock(control As IRibbonControl, pressed As Boolean)
ActiveWindow.Selection.ShapeRange.LockAspectRatio = msoTriStateToggle
End Sub

Code on Class Module(very much unsure)
Private Sub App_WindowSelectionChange(ByVal Sel As Selection)
'Handles Application.WindowSelectionChange
'ActiveWindow.Selection.ShapeRange.LockAspectRatio = msoTriStateToggle
MsgBox "selection change1"

If Application.ActiveWindow.Selection.ShapeRange = ppSelectionShapes Then
If Application.ActiveWindow.Selection.ShapeRange.LockAspectRatio = msoTrue Then
MsgBox "lock"
Else
MsgBox "unlock"
End If
End If

Dim oRibbon As IRibbonUI
Set oRibbon = MainModule.gb_oMyRibbon1

oRibbon.InvalidateControl "MyToggleButton1"

End Sub

 

[Worf]

You are welcome.

Can you finish the project from here?

 

[rodrigolf]

Worf, thank you for your support! I followed your orientations, but could not follow. In this case, how should we specify the getEnable sub? Can you help finishing the project from there?

 

[rodrigolf]

I figured it out by myself. And will post the final code here. I hope it is useful in the future to someone.

CLASS MODULES
Name: EventClassModules

Option Explicit
Public WithEvents App As PowerPoint.Application

Private Sub App_WindowSelectionChange(ByVal Sel As Selection)
InvalRibbon   'Calls procedure in the code module to invalidate the ribbon when the selection changes
End Sub

MODULES
Name: Module1

[/I]
Option Explicit
Public MyRibbon As IRibbonUI
Dim X As New EventClassModule
Public IsPressed As Boolean

'Procedure to invalidate the ribbon called from the event class
Sub InvalRibbon()
    MyRibbon.Invalidate
End Sub

'Callback for customUI.onLoad
Sub OnLoad(ribbon As IRibbonUI)
    Set MyRibbon = ribbon
End Sub

'Callback for AutoCalc getPressed

Sub getPressedStyleBtn(control As IRibbonControl, ByRef returnedVal)

'START: Error message box -----------------------------------------------
On Error Resume Next
    Err.Clear
   If ActiveWindow.Selection.ShapeRange.Count = 0 Then
      InvalRibbon
        Exit Sub
    End If
    If Err <> 0 Then
        Exit Sub
    End If
'END: Error message box -------------------------------------------------

    If ActiveWindow.Selection.HasChildShapeRange Then
        Select Case control.Id
        Case "AutoCalc"
            If ActiveWindow.Selection.ChildShapeRange().LockAspectRatio = msoTrue Then
                returnedVal = "True"
                Else
                returnedVal = "False"
            End If
         End Select
    Else
        Select Case control.Id
        Case "AutoCalc"
            If ActiveWindow.Selection.ShapeRange().LockAspectRatio = msoTrue Then
                returnedVal = "True"
                Else
                returnedVal = "False"
            End If
        End Select
    End If
    
End Sub

'Callback for AutoCalc onAction
Sub Lock_and_Unlock(control As IRibbonControl, pressed As Boolean)

'START: Error message message box -----------------------------------------------
On Error Resume Next
    Err.Clear
   If ActiveWindow.Selection.ShapeRange.Count = 0 Then
      MsgBox "You must have at least one shape selected.", vbCritical
        Exit Sub
    End If
    If Err <> 0 Then
        Exit Sub
    End If
'START: Error message message box -----------------------------------------------
    
    If pressed Then
        Select Case control.Id
            Case "AutoCalc"
                ActiveWindow.Selection.ShapeRange().LockAspectRatio = msoTrue
                ActiveWindow.Selection.ChildShapeRange().LockAspectRatio = msoTrue
        End Select
    Else
        ActiveWindow.Selection.ShapeRange().LockAspectRatio = msoFalse
        ActiveWindow.Selection.ChildShapeRange().LockAspectRatio = msoFalse
        MyRibbon.InvalidateControl (control.Id)
    End If
        
End Sub
[I]

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" onLoad="Module1.OnLoad">
 <ribbon>
  <tabs>
   <tab id="CustomTab1" label="Custom" >
<!-- STYLES -->
    <group id="TEST" label="TEST">
       <toggleButton
          id=        "AutoCalc"
          label=     "Lock"
          showLabel= "true"
          getPressed="getPressedStyleBtn"
          onAction=  "Lock_and_Unlock" />
    </group>
   </tab>
  </tabs>
 </ribbon>
</customUI>

 

[rodrigolf]

I erased one line of Module1 unintentionally that is critical to detect the status of the selected shape. Just change as below:

'Callback for customUI.onLoad
Sub OnLoad(ribbon As IRibbonUI)
    Set MyRibbon = ribbon
    Set X.App = PowerPoint.Application
End Sub