Run a macro when I click a powerpoint shape in edit mode

Question

I want to be able to change some values of a certain shape when I click on it. But I want to make it when powerpoint is in edit mode (I don't know if it is said like that), not in slide show mode. I have been looking on Internet and I only found a way to make it on slide show mode, so when the presentation is running.

Here is the code that I found

Private Sub createSwipeNext(color)
    Dim swipArrow As Shape
    Dim subName As String
    subName = "Identify"
    Set cSlide = Application.ActiveWindow.View.Slide
    'ActiveWindow.Selection.Unselect
    Set swipArrow = cSlide.Shapes.AddShape(msoShapeRightArrow, ActivePresentation.SlideMaster.width + 10, ActivePresentation.SlideMaster.height / 2, 40, 30)
    If color = "green" Then
        swipArrow.Fill.ForeColor.RGB = vbGreen
    Else
        swipArrow.Fill.ForeColor.RGB = vbRed
    End If
    swipArrow.name = "Dink swipe arrow"

    'swipArrow.ActionSettings(ppMouseClick).Run = subName
    With swipArrow.ActionSettings(ppMouseClick) ' or ppMouseOver if you prefer
         .Run = subName
         .Action = ppActionRunMacro
      End With
 End Sub

With this code is possible to click to the shape on slide Show mode and run Identify() method. I want to make the same but in edit mode, so when the presentation is not running. Is that possible?

Answer 1

Possible but definitely not easy. You would need to write a class module to detect the selection event.

The code posted doesn't make a lot of sense. Maybe start again and just say what you want to happen when the shape is clciked (in show mode)

Answer 2

it is possible to do so i just did it my self right now all you need is download this file http://www.officeoneonline.com/eventgen/EventGen20.zip install it create a class module paste this code Option Explicit

Public WithEvents PPTEvent As Application



Private Sub Class_Initialize()
End Sub


Private Sub PPTEvent_WindowSelectionChange(ByVal Sel As Selection)
If Sel.Type = ppSelectionShapes Then
    If Sel.ShapeRange.HasTextFrame Then
        If Sel.ShapeRange.TextFrame.HasText Then
           If Trim(Sel.ShapeRange.TextFrame.TextRange.Text) = "Text inside your shape" Then
              Sel.Unselect
              yoursub
           End If
       End If
     End If

   End If

End Sub

insert a new module paste this code

Dim cPPTObject As New Class1

Dim TrapFlag As Boolean

 Sub TrapEvents()
      If TrapFlag = True Then
         MsgBox "Already Working"
         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

 Sub yoursub()
         MsgBox "Your Sub is working"
 End Sub

Now run TrapEvents and whenver you will click shape with that text in it your sub will run Credits to the person who wrote this http://www.officeoneonline.com/eventgen/eventgen.html