In vba(PowetPoint), I added animation effects to a shape object.
But any effects I set vanished without a sound effect if I added a sound effect.
The following is sample code.
I splittd their effects to one shape by one effect, the other shape by sound effect.
But I could not solve.
Sub hoge()
Const path As String ="./sound.wav"
Dim ppSld As PowerPoint.Slide
Dim shp As Shape
Set ppSld = ActivePresentation.Slides(1)
Set shp = ppSld.Shapes.AddShape(msoShapeRectangle, 0, 0, 10, 10)
With ppSld.TimeLine.MainSequence.AddEffect( _
Shape:=shp _
, effectId:=msoAnimEffectFly)
effect.Timing.Duration = 10 'duration time
effect.EffectInformation.SoundEffect.ImportFromFile path 'sound
End With
End Sub
Related
I am trying to change the text color of the chart title of a histogram chart in PowerPoint.
Here is what I do:
var colorFormat = chart.ChartTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor;
colorFormat.RGB = ...;
// or
colorFormat.ObjectThemeColor = ...;
This works for the standard charts like line charts. But it doesn't work for other chart types like histogram, waterfall, tree map etc.
In these cases, setting ObjectThemeColor sets the text to black. Setting RGB does actually set the correct color. However, in both cases, as soon as the user changes the selection, the text color jumps back to the one it had previously.
How can I set the text color of the title of one of these charts?
I am using VSTO and C# but a VBA solution is just as welcome as long as it can be translated to C# and still work.
Based on what info you gave I built a histogram and waterfall chart in PowerPoint and was successful using:
Sub ChartTitleFontColor()
Dim oShp As Shape
Dim oCht As Chart
'Waterfall on slide 1
Set oShp = ActivePresentation.Slides(1).Shapes(1)
If oShp.HasChart Then
Set oCht = oShp.Chart
End If
' Do stuff with your chart
If oCht.HasTitle Then
Debug.Print oCht.ChartTitle.Text
oCht.ChartTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(251, 5, 40)
End If
'Histogram on slide 2
Set oShp = ActivePresentation.Slides(2).Shapes(1)
If oShp.HasChart Then
Set oCht = oShp.Chart
End If
' Do stuff with your chart
If oCht.HasTitle Then Debug.Print oCht.ChartTitle.Text
oCht.ChartTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(251, 5, 40)
End If
' Clean up
Set oShp = Nothing
Set oCht = Nothing
End Sub
Your code works in my test. I created two charts in PowerPoint 2016, the first one a waterfall, and the second another type. The following code changes the title color only (and text just a proof of it being changed) and nothing else. I can select the other chart and nothing changes. I could not find a bug about this in a search. Perhaps something in the remaining code is changing it back?
Sub test()
Dim myPresentation As Presentation
Set myPresentation = ActivePresentation
Dim myShape As Shape
Set myShape = myPresentation.Slides(1).Shapes(1)
Dim theChart As Chart
If myShape.HasChart Then
Set theChart = myShape.Chart
If theChart.ChartTitle.Text = "This is blue" Then
theChart.ChartTitle.Text = "This is yellow"
theChart.ChartTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 0)
Else
theChart.ChartTitle.Text = "This is blue"
theChart.ChartTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 255, 255)
End If
End If
End Sub
This is not exactly an answer but I think you should name your object.
Instead of using
ActivePresentation.Slides(1).Shapes(1)
You can name the object.
Here is my code: (Using PowerPoint 2016)
Sub MacroTest()
Dim Shp As Shape
Dim effNew As Effect
Dim sldOne As Slide
Set sldOne= ActivePresentation.Slides(1)
Set Shp = ActivePresentation.Slides(1).Shapes(2)
Set effNew = sldOne.Timeline.MainSequence _
.AddEffect(Shape:=Shp, _
effectid:=msoAnimEffectSpin, _
Trigger:=msoAnimTriggerWithPrevious)
End Sub
My goal with this code is to see if I can apply it to a PowerPoint game. I want to be able to have the user click a button to make a box spin, and then have the animation deleted immediately after so that if they click it again, it won't play two or more spin animations. Also, I want the animation deleted so the animation pane won't have hundreds of spin animations in it.
Most the examples I have seen use .AddShape, because the animation disappears with the shape - however, it would be easier to apply an animation to an existing shape that I can see and interact with when designing a game.
I am aware that this is achievable without VBA, using triggers, but I eventually want to incorporate if then statements and more code to this once I get the hang of it.
I appreciate any help, I am very new to VBA so it means a lot.
Okay so I figured it out. This is for anyone who is having a similar problem.
Code:
Sub MacroTest
Dim Shp As Shape
Dim effNew As Effect
Dim sldOne As Slide
Dim time As Date
Dim count As Integer
Set sldOne = ActivePresentation.Slides(1)
Set Shp = ActivePresentation.Slides(1).Shapes(2)
Set effNew = sldOne.TimeLine.MainSequence _
.AddEffect(Shape:=Shp, _
effectid:=msoAnimEffectSpin, _
Trigger:=msoAnimTriggerWithPrevious)
time = Now()
count = 2
time = DateAdd("s", count, time)
Do Until time < Now()
DoEvents
With effNew
With ActivePresentation.Slides(1).Shapes(4). _
TextFrame.TextRange
.Text = Format((time - Now()), "hh:mm:ss")
If .Text = ("00:00:00") Then
effNew.Delete
Else
End If
End With
End With
Loop
End Sub
So, What I had to do was create a timer, which lasts as long as the spin animation I am using. Then I used an if statement for when that timer reaches 00:00:00 to delete the effect. Hope this helps.
I'm writing a simple code to position my shapes (which are actually pictures) in the document. I want them to be positioned:
horizontally to exactly 0 mm. from the left side of the printable area
vertically to 7 mm. below the paragraph (to which the shape is anchored)
I wrote a simple code:
Selection.ShapeRange.RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
Selection.ShapeRange.Left = MillimetersToPoints(0)
Selection.ShapeRange.RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
Selection.ShapeRange.Top = MillimetersToPoints(7)
Selection.ShapeRange.WrapFormat.Type = wdWrapTopBottom
For 1 shape on the page it works fine. But if there are more then 1 shape, it somehow "throws" the 2nd shape to the top of the page. It looks like Word anchors it to the 1st paragraph on the page. but it shouldn't. At the same time horizontal positioning is ok.
I would appreciate any help to fix this issue.
My possible solution for this issue will look as follows:
Sub PositShape_3()
Dim I As Integer
If Selection.InlineShapes.Count <> 0 Then
For I = Selection.InlineShapes.Count To 1 Step -1
Selection.InlineShapes(I).ConvertToShape
Next I
End If
Selection.ShapeRange.RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
Selection.ShapeRange.Left = MillimetersToPoints(0)
Selection.ShapeRange.RelativeVerticalPosition = wdRelativeVerticalPositionLine
Selection.ShapeRange.Top = MillimetersToPoints(7)
Selection.ShapeRange.WrapFormat.Type = wdWrapTopBottom
End Sub
In spite of the fact that the use of wdRelativeVerticalPositionLine solved the problem, it is still interesting why the use of wdRelativeVerticalPositionParagraph has such unexpected unwanted consequences.
Note the use of SELECTION in the code you show us. If you don't change the paragraph selection, then the shapes will always be anchored to the same paragraph. Working with a Selection in Word is tricky; it's much better to work with a more tangible object, such as a specific paragraph.
The following code sample illustrates using paragraph objects to anchor and position successively added Shapes.
Sub insertShapesProgressively()
Dim shp As word.Shape
Dim shpRng As word.ShapeRange
Dim rng As word.Range
Dim iParaCounter As Long
'We want to insert the Shape anchored to three different paragraphs
' on the same page
For i = 7 To 9
Set rng = ActiveDocument.Paragraphs(i).Range
Set shp = ActiveDocument.shapes.AddShape(msoShapeWave, 0, 0, 10, 10, rng)
Set shpRng = rng.ShapeRange
shpRng.RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
shpRng.Left = MillimetersToPoints(0)
shpRng.RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
shpRng.Top = MillimetersToPoints(7)
shpRng.WrapFormat.Type = wdWrapTopBottom
Next
End Sub
I wrote some code for a client which isn't working correctly on his machine (Win 10, Office 365) but is on mine (Win 10, Office 2016). The code inserts an image to the header then positions it and resizes it. I use the ConvertToShape method so I can access properties like width, height and position of the Shape class.
Dim pic As Shape
Dim shp As Word.InlineShape
Set shp = thisDocument.Sections.Item(1).Headers(wdHeaderFooterPrimary).Range.InlineShapes.AddPicture(fpImage) ' insert the image to the header
Set pic = shp.ConvertToShape ' THIS LINE CAUSES THE PROBLEM
The method causes the image to disappear. 'Pic' is still available and setting it's properties causes no error, but it is not visible. It's .visible property returns true.
Any ideas? Thanks.
Answer provided to cross-post at Microsoft Community
There is a way to do this with only an inline shape, by setting up a table to position the text on the left and the picture on the right. An additional advantage of this method is that, if you set the table's AutoFitBehavior property to wdAutoFitFixed and set the column width to the width you want for the shape, Word will automatically resize the picture to that width and keep the aspect ratio.
Here's a little sample macro:
Sub x()
Dim fpImage As String
Dim strExistingHeaderText
Dim tbl As Table
Dim shp As InlineShape
fpImage = "D:\Pictures\bunnycakes.jpg"
With ActiveDocument
strExistingHeaderText = _
.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text
Set tbl = .Tables.Add( _
Range:=.Sections(1).Headers(wdHeaderFooterPrimary).Range, _
numrows:=1, numcolumns:=2, _
AutoFitBehavior:=wdAutoFitFixed)
tbl.Columns(2).Width = InchesToPoints(1.5)
tbl.Columns(1).Width = InchesToPoints(5#)
tbl.Cell(1, 1).Range.Text = strExistingHeaderText
'tbl.Borders.Enable = False
Set shp = tbl.Cell(1, 2).Range.InlineShapes.AddPicture(fpImage)
End With
End Sub
I trying to make PowerPoint load up images to replace placeholders everytime a slide changes.
I have the code working, which changes the placeholders with images from local drive or url. But it wont work on OnSlideShowPageChange() event(mentioned here). With no prior experience on VB/VBA, I have no idea why, as it does not give any errors. I know the event is accessed because if I put a MsgBox()-function in it, it is displayed.
ImageReplace code:
Dim strPicName As String
Dim shp As Shape
Dim sglShapeLeft As Single
Dim sglShapeTop As Single
Dim sglShapeHeight As Single
Dim sglShapeWidth As Single
'Get the name of the shape (image)
'Provided this is the only shape on the slide
'Since I don't think you can use the ME. keyword to reference an impage from Powerpoint VBA
'(Me.shape.Name)
For Each shp In ActiveWindow.Selection.SlideRange.Shapes
strPicName = shp.Name
Next shp
'Select the Image
ActiveWindow.Selection.SlideRange.Shapes(strPicName).Select
'Get the Left and Top starting points and width and height
sglShapeLeft = ActiveWindow.Selection.SlideRange.Shapes(strPicName).Left
sglShapeTop = ActiveWindow.Selection.SlideRange.Shapes(strPicName).Top
sglShapeHeight = ActiveWindow.Selection.SlideRange.Shapes(strPicName).Height
sglShapeWidth = ActiveWindow.Selection.SlideRange.Shapes(strPicName).Width
'Delete the Image
ActiveWindow.Selection.ShapeRange.Delete
'Insert a new Image at the same starting points as the previous image
ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:="<picturePath/url>", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=sglShapeLeft, Top:=sglShapeTop, Width:=sglShapeWidth, Height:=sglShapeHeight).Select
For Each shp In ActiveWindow.Selection.SlideRange.Shapes
strPicName = shp.Name
Next shp
ActiveWindow.Selection.SlideRange.Shapes(strPicName).IncrementRotation 276#
Any help is appreciated
ActiveWindow is not accessible when in slide show view.
Try this instead
Dim sld As Slide
Set sld = ActivePresentation.Slides _
(ActivePresentation.SlideShowWindow.View _
.CurrentShowPosition)
Set shp = sld.Shapes(1)
With shp
sld.Shapes.AddPicture(FileName:="<picturePath/url>", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height).IncrementRotation 276#
.Delete
End With
BTW, debugging and exceptions do not seem to be supported in the OnSlideShowPageChange event. As an easy approach place a MsgBox after each line of code to see where the execution stops.