Is it possible to change the shape color on mouse hover using VBA in PowerPoint?
I tried creating the same effect using animations+trigger but it requires a click. However I would like to change the shape color as I hover the mouse over it and change it back to the original color as I hover the mouse to next shape. Is this possible to achieve?
Thanks in advance.
This is possible with a hack approach to overcome the fact that PowerPoint doesn't support the mouse-out event. What you can do is write a mouse-over macro as follows to change the colour:
Option Explicit
Public myShape as Shape ' Global reference to mouse over shape
Sub MouseOver(oShp As Shape)
Set myShape = oShp
With oShp
' Change the properties you need here
End With
End Sub
Assign that to your shape via Insert / Action / Mouse Over / Run Macro
Next, and this is the hack for no mouse-out event, add a rectangle shape to your slide on the bottom layer. Set the fill transparency to 100% and assign the following macro to it's mouse-over event:
Sub MouseOutHack()
With myShape
' Reset the properties you need here
End With
End Sub
Now, when you move the mouse over your shape, it's properties will change and when you move it out of the shape, the invisible background shape will trigger the resetting of the properties you choose.
Related
I would like to make a macro in Powerpoint that enables me to create shapes in a similar fashion as when you select the autoshapes in the autoshape overview (i.e. once you call the macro you have a possibility to click to set the coordinates and subsequently you drag and click to set the width&height). Also, I would like to give it pre-set cosmetic characteristics (e.g. certain inner margins, fill color, border style and transparancy), which will be defined in the vba code.
I am aware of .addshapes(), however, this requires coordinates and height/width as input. Moreover, I have not find any posts / documents on vba to create shapes without defined coordinates and height/width.
Anyone some ideas on how to tackle this challenge?
Many thanks in advance!
Sofar
Building on what John Korchok suggested, here's code that retrieves the just-drawn shape so that your code can resume and manipulate it...
Sub testAppComBars()
Dim SHP As Shape
Application.CommandBars.ExecuteMso ("ShapeFreeform")
Stop
Set SHP = Selection.ShapeRange(1)
With SHP.Fill
.ForeColor.RGB = RGB(192, 0, 0)
.Transparency = 0.75
End With
End Sub
I would hope there's a more elegant solution than using Stop to pause code execution while the user picks the shape's location (or in this case, draws a freeform polyline/polygon), but that's all I could come up with off the top of my head.
I was fascinated by this problem and think this might help you.
Consider that when you draw a new autoshape, you have changed the window selection, and created a new selection ShapeRange with exactly 1 item (the new shape).
So by setting a WindowSelectionChange event, you're able to apply any formatting you wish at the time of creation.
First create a class module called cPptEvents with the following:
Public WithEvents PPTEvent As Application
Private Sub PPTEvent_WindowSelectionChange(ByVal sel As Selection)
On Error GoTo Errhandler
Debug.Print "IN_PPTEvent_WindowSelectionChange"
Dim oShp As Shape
If (ActiveWindow.ViewType = ppViewNormal) Then
With sel
If .Type = ppSelectionShapes Then
If .ShapeRange.Count = 1 Then
Set oShp = .ShapeRange(1)
If oShp.Type = msoAutoShape Then
If oShp.AutoShapeType = msoShapeOval Then
If oShp.Tags("new_oval") = "" Then
oShp.Fill.ForeColor.RGB = RGB(255, 0, 0)
oShp.Tags.Add "new_oval", "true"
End If
End If
End If
End If
End If
End With
End If
Exit Sub
Errhandler:
Debug.Print "Error: " & Err.Description
End Sub
This checks the selection every time it changes. If there's an oval selected, it looks for the "new_oval" tag, which will not exist for a newly created shape. In that case, it applies a red fill, although of course once you get to this point you can call an entirely different sub, pass along the shape, and do whatever you want formatting-wise to it.
By adding that "new_oval" tag, you ensure that the formatting will not be applied to an oval that hasn't been newly created. This allows the user to make manual changes to the formatting as needed -- otherwise you're just resetting the formatting every time the user selects an oval.
Note that for the _WindowSelectionChange event to be running in the background, you have to call this at some point:
Public MyEventClassModule As New cPptEvents
'
Public Sub StartMeUp()
Set MyEventClassModule.PPTEvent = Application
End Sub
You can include that one line from StartMeUp above in whatever Ribbon_Onload sub is triggered by your addin, if you're making a new addin ribbon.
With this solution, you don't even have to give the end user a special button or set of tools to create the shapes that are being formatted. It happens invisibly whenever the user draws a new shape from the native PPT tools.
This will put your cursor in drawing mode to draw an oval. After running, you may have to click on the slide once, then the cursor will change shape and you can draw an oval:
Sub DrawOval()
Application.CommandBars.ExecuteMso ("ShapeOval")
End Sub
Other commands to substitute for ShapeOval:
ShapeRectangle
ShapeElbowConnectorArrow
ShapeStraightConnectorArrow
Get the full list in Excel spreadsheets from Microsoft Office 2016 Help Files: Office Fluent User Interface Control Identifiers
Look for the powerpointcontrols.xlsx file and search the first column with "shape"
There are 173 shapes in the menu, so you have a lot of macros to write.
I want to apply trigger animation when mouse over
I found very helpful tutorial so I can make the animation happen when mouse Over the button, but it allow the animation to happen only when the mouse come over the button again
What I need is to the required animation happen as below:
- when mouse over the button, the image appears
- when mouse out the button, the image disappears
(with no need to mouse re-over again the shape button)
Can someone help me achieve that.
here is the VBA code which in the tutorial,
Sub anim(oshp As Shape)
Dim osld As Slide
Set osld = oshp.Parent
'Note alter the name here to match the trigger shape
If osld.Shapes("Rectangle 7").ZOrderPosition = 1 Then
SendKeys ("{TAB}")
SendKeys ("{ENTER}")
Else
osld.Shapes("Rectangle 7").ZOrder (msoSendToBack)
End If
End Sub
I am new to VBA (since this morning so please treat me like an idiot and you will be about right!) and am stuck on something that seems as though it should be very simple.
I am working in PowerPoint and have a set of circles and below them a red and a green coloured square.
I would like to be able to select a relevant circle and then click on the appropriate square to change that circle only to red or green, as below
Select your option: O O O O O
Change colour: [Red] [Green]
At the moment I am using animations and triggers but I have LOTS of circles and I only want to change them one at a time.
+1 to Siddharth for that answer. There's another bit that won't be apparent if you're just getting started out. You can have PPT pass a reference to the clicked shape when the shape triggers a macro (caution: Mac PPT is buggy/incomplete. This won't work there).
Using Siddharth's suggestion as a jumping off point, you can do something like this:
Option Explicit
Sub SelectMe(oSh As Shape)
' assign this macro to each of the shapes you want to color
' saves time to assign it to one shape, then copy the shape as many
' times as needed.
ActivePresentation.Tags.Add "LastSelected", oSh.Name
End Sub
Sub ColorMeRed(oSh As Shape)
' assign this macro to the "color it red" shape
' when this runs because you clicked a shape assigned to run the macro,
' oSh will contain a reference to the shape you clicked
' oSh.Parent returns a reference to the slide that contains the shape
' oSh.Parent.Shapes(ActivePresentation.Tags("LastSelected")) returns a reference
' to the shape whose name is contained in the "LastSelected" tag,
' which was applied in the SelectMe macro above.
' Whew!
If Len(ActivePresentation.Tags("LastSelected")) > 0 Then
With oSh.Parent.Shapes(ActivePresentation.Tags("LastSelected"))
.Fill.ForeColor.RGB = RGB(255, 0, 0)
End With
End If
End Sub
Sub ColorMeBlue(oSh As Shape)
' assign this macro to the "color it blue" shape
If Len(ActivePresentation.Tags("LastSelected")) > 0 Then
With oSh.Parent.Shapes(ActivePresentation.Tags("LastSelected"))
.Fill.ForeColor.RGB = RGB(0, 0, 255)
End With
End If
End Sub
With PowerPoint 2007 & 2010, I have been trying to change the Type of Gradient Fill on a Shape object from default "Rectangular" to "Path" for days. Searched online but seems like no such question asked.
So far I can only get the Gradient Fill to be "Rectangle" (the default with 2 color gradient?). But I want it to be "Path". So far only able to do that by right click on the actual Shape --> Format Shape. "Format Shape" form shows and I can change the "Type:" from Rectangle to Path. But I want to do this change in VBA, anyone have a solution?
My code below. Variables starting with g are As Single
Set oSlide = ActivePresentation.Windows(1).View.Slide
With oSlide.Shapes.AddShape(msoShapeIsoscelesTriangle, gLeft, gTop, gWidth, gHeight)
.Line.Visible = msoFalse ' No Outline
.Adjustments(1) = gAdj1 ' Adjust the position of the pointing tip
.Rotation = gAngle ' Change the angle of Rotation
.Fill.Visible = msoTrue
.Fill.TwoColorGradient msoGradientFromCenter, 1 ' Enable Two Colour Gradient
.Fill.GradientStops(1).Color.RGB = RGB(255,255,255) ' Colour at center
.Fill.GradientStops(2).Color.RGB = RGB(121,121,121) ' Colour at edge
.Select
End With
Set oSlide = Nothing
If no VBA codes can achieve that, I will have to use workaround... Copy and Paste those Shapes from a Template file - this sounds bad as I am going to make it a PowerPoint AddIn.
Thanks in advance!
Patrick
I was wondering if there was any way that I could write in Powerpoint 2010 VBA a small program that animates a gif when a mouse cursor is hovered over it.
Not exactly, but you can write a macro that makes one picture visible when you mouse over another shape.
So add a shape of any sort, it might be a non-animated version of the animated gif, for example. Assign it an Action setting on mouseover of Run Macro: ShowMe
First, add this to your presentation:
Sub ShowMe()
' Edit this to change the slide number as needed and to
' change "Picture 1" to the actual name of the animated gif
ActivePresentation.Slides(1).Shapes("Picture 1").Visible = True
End Sub
Then use the selection pane to make the animaged gif invisible.
You could put a slightly larger shape behind both of these shapes and set its mouseover action to the macro HideMe, which is the same as ShowMe but set .Visible = False
When the cursor hovers over the ShowMe trigger shape, the anigif becomes visible; when the cursor moves off the gif, it falls on the HideMe shape which triggers the second macro and hides the GIF again.