Lock button in Powerpoint Custom Ribbon

emranali1989

New Member
Joined
Jun 15, 2020
Messages
5
Office Version
2010
Platform
Windows
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
 

Some videos you may like

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
4,004
Welcome



The code below toggles the state of a single shape; next step is to make the ribbon button react to slide selections.

VBA Code:
'Callback for MyToggleButton1 onAction

Sub Lock_and_Unlock(control As IRibbonControl, pressed As Boolean)
Dim sh As ShapeRange
Set sh = ActiveWindow.Selection.ShapeRange
MsgBox sh.LockAspectRatio, , sh.Name & " initial state"
Select Case sh.LockAspectRatio
    Case msoTrue
        sh.LockAspectRatio = msoFalse
    Case msoFalse
        sh.LockAspectRatio = msoTrue
End Select
MsgBox sh.LockAspectRatio, , sh.Name & " new state"
End Sub
 

emranali1989

New Member
Joined
Jun 15, 2020
Messages
5
Office Version
2010
Platform
Windows
Hello, Thanks for asking.
Yet i have not able to complete the above task. It would be great help if you could help me on this.
Thanks
 

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
4,004
This is the event part:

VBA Code:
'PowerPoint class module named EventClass

Public WithEvents PPTEvent As Application

Private Sub Class_Terminate()
MsgBox "EventHandler is now inactive.", vbInformation + vbOKOnly, _
"PowerPoint Event Handler Example"
End Sub

Private Sub PPTEvent_WindowSelectionChange(ByVal Sel As Selection)
If Sel.Type = ppSelectionShapes Then _
MsgBox Sel.ShapeRange.LockAspectRatio, 64, "Lock status"
End Sub

Private Sub Class_Initialize()
MsgBox "The EventHandler class has been initialized."
End Sub
VBA Code:
' Powerpoint standard module
Dim cPPTObject As New EventClass, TrapFlag As Boolean
Sub TrapEvents()
MsgBox "Trapping event..."
If TrapFlag = True Then
    MsgBox "the EventHandler is already active.", _
    vbInformation + vbOKOnly, "PP Event Handler"
    Exit Sub
End If
Set cPPTObject.PPTEvent = Application
TrapFlag = True
End Sub

Sub ReleaseTrap()
If TrapFlag = True Then
    Set cPPTObject.PPTEvent = Nothing
    Set cPPTObject = Nothing
    TrapFlag = False
End If
End Sub
 

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
4,004
Note the name...

ppoint.PNG
 

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
4,004
This example shows how the ribbon can recognize what is happening on the slides:

PP_ribbon.PNG


VBA Code:
'PowerPoint class module named EventClass

Public WithEvents PPTEvent As Application

Private Sub Class_Terminate()
MsgBox "EventHandler is now inactive.", vbInformation + vbOKOnly, _
"PowerPoint Event Handler Example"
End Sub

Private Sub PPTEvent_WindowSelectionChange(ByVal Sel As Selection)
If Sel.Type = ppSelectionShapes Then
    pv = Sel.ShapeRange.LockAspectRatio
    MsgBox pv, 64, "Lock status"
    ULabel
End If
End Sub

Private Sub Class_Initialize()
MsgBox "The EventHandler class has been initialized."
End Sub
VBA Code:
' Powerpoint standard module

Public pv
Dim ribbonUI As IRibbonUI, cPPTObject As New EventClass, TrapFlag As Boolean

Sub ribbonLoaded(ribbon As IRibbonUI)
Set ribbonUI = ribbon
End Sub

Sub ULabel()
ribbonUI.InvalidateControl ("Login")
End Sub

Sub getLL(control As IRibbonControl, ByRef returnedVal)
returnedVal = CStr(pv)
End Sub

Sub TrapEvents()
MsgBox "Trapping event..."
If TrapFlag = True Then
    MsgBox "the EventHandler is already active.", _
    vbInformation + vbOKOnly, "PP Event Handler"
    Exit Sub
End If
Set cPPTObject.PPTEvent = Application
TrapFlag = True
End Sub

Sub ReleaseTrap()
If TrapFlag = True Then
    Set cPPTObject.PPTEvent = Nothing
    Set cPPTObject = Nothing
    TrapFlag = False
End If
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,102,545
Messages
5,487,496
Members
407,603
Latest member
jortronm

This Week's Hot Topics

Top