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
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.
.addPicture requires width and height, but this could end up distorting the image. Is there any way to use .LockAspectRatio = msoCTrue when adding the file image?
Also, how do you stipulate a page to put the canvas or the picture? Macro recorder needs to be stopped before one can work on images somehow.
Set sCanvas = ActiveDocument.Shapes _
.AddCanvas(Left:=MillimetersToPoints(20), Top:=MillimetersToPoints(20), _
Width:=300, Height:=200)
Set CanvasShapes = sCanvas.CanvasItems
With CanvasShapes
.AddPicture FileName:="C:\somepath\image.png", _
Left:=0, Top:=0, Width:=150, Height:=100
...
End With
Set the canvas size to 0 and lock it's aspect ratio, then add the picture. The canvas will scale to accommodate it. After the image is loaded, then scale the canvas as needed:
Set sCanvas = ActiveDocument.Shapes.AddCanvas(MillimetersToPoints(20), MillimetersToPoints(20), 0, 0)
sCanvas.LockAspectRatio = True
Set CanvasShapes = sCanvas.CanvasItems
With CanvasShapes
.AddPicture "C:\somepath\image.png"
End With
'Scale the canvas here.
You could try to obtain the dimensions using the code here (pasted below for reference)
Sub test()
Dim objShell As Object
Dim objFolder As Object
Dim objFile As Object
Dim fPath As Variant 'MUST be a variant, not a string
Dim fName As String
fPath = "C:\somepath"
fName = "image.png"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(fPath)
Set objFile = objFolder.ParseName(fName)
MsgBox objFile.ExtendedProperty("Dimensions")
End Sub
This will give you the dimensions of the picture which you can then use.
It looks like the output is ? w x h ? so you'll need to parse it, but this should work.
Note that if you want to use a variable to define the file path, it must be declared as a variant, per here
If you check the definition of the AddPicture method you will find that except for FileName all of the arguments are optional, so Height and Width are not required.
Unless you have a specific reason for adding a canvas it is also unnecessary to add a canvas before adding a picture.
Word has no concept of pages so you cannot specify that the picture should appear on a certain page.
Managed to find a way to put a picture to a specific page (page 2 in example below) in MS Word:
Dim pNum as long
pNum = 2
Selection.GoTo What:=wdGoToPage, Count:= pNum
I am trying to add a picture (company logo) into a header by code.
This worked fine so far until there showed up some documents which contain a table in the header, which I want to keep there too.
Problem is: my code adds the picture into the first table cell. What i want is that the picture is positioned in the top right corner of the page (with some margin to the page) .. but outside the table.
How do I need to modify my code to do that? I guess the problem is the Range I use:
Set oSec = ActiveDocument.Sections(1)
Set oHeader = oSec.Headers(wdHeaderFooterFirstPage)
Set Rng = oHeader.Range '<<-- Problem here? What to do if there is a table in the header
Set sh = ActiveDocument.shapes.AddPicture(LogoFile, False, True, 0, 0, , , Rng)
With sh
.Height = LogoDimension
.Width = LogoDimension
.WrapFormat.Type = wdWrapTopBottom
.WrapFormat.Side = wdWrapTopBottom
.WrapFormat.DistanceBottom = MillimetersToPoints(10)
.RelativeHorizontalPosition = wdRelativeHorizontalPositionRightMarginArea
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Left = MillimetersToPoints(0.5) - LogoDimension
.Top = MillimetersToPoints(11.5)
End With
Thanks for any hints!
I was able to test the scenario on my dev machine and could reproduce the problem. Shape management in Word's Headers/Footers is notorious for being "pliable" - this appears to be another one of those things.
What works is to insert the graphic in the paragraph below the table as an InlineShape object, use the ConvertToShape method, then immediately lock the anchor of the Shape so that moving it doesn't shift the anchor position to the nearest paragraph (table cell).
Sub InsertPicInHeaderOutsideTable()
Dim oSec As word.Section
Dim oHeader As word.HeaderFooter
Dim rng As word.Range
Dim sh As word.Shape, ils As word.InlineShape
Set oSec = ActiveDocument.Sections(1)
Set oHeader = oSec.Headers(wdHeaderFooterFirstPage)
Set rng = oHeader.Range
'**** Add the followign four lines to code in your question ****
rng.Collapse wdCollapseEnd
Set ils = rng.InlineShapes.AddPicture(LogoFile, False, True, rng)
Set sh = ils.ConvertToShape
sh.LockAnchor = True
With sh
'and so on...
after some more playing around with it I found the solution:
.LayoutInCell = False
adding this attribute to the shape will lead to positioning the picture as wanted and not affect the table anymore.
edit: this was not entirely correct it seems. The picture is still added to the table .. just not positioned in the cell anymore. If I delete the table for testing the picture gets deleted automatically with it. So this is not an ideal solution still.
I think still the range used is the problem
I have been working on a small hack around with Power Point to automatically create a Text Box Shape with some preset effect in which the text is dynamically fetched from clipboard. I have quiet a bit of a problem here, the functionality works fine with the following VB script with macros.
Sub ReadFromFile()
' CLIPBOARD
Dim MyData As DataObject
Dim strClip As String
' CLIPBOARD
Set MyData = New DataObject
MyData.GetFromClipboard
strClip = MyData.GetText
Set activeDocument = ActivePresentation.Slides(1)
With activeDocument
'Set QASlide = .Slides.Add(Index:=.Slides.Count + 0, Layout:=ppLayoutBlank)
activeDocument.Shapes.AddTextEffect PresetTextEffect:=msoTextEffect28, _
Text:=strClip, _
FontName:="Garde Gothic", FontSize:=44, FontBold:=msoTrue, _
FontItalic:=msoFalse, Left:=25, Top:=25
With .Shapes(.Shapes.Count)
.Width = 200
.Height = 300
End With
End With
End Sub
Can some one help me in providing the script for wrapping the text inside the shape which has a defined width and height as in the code above?
Not sure if I understand you right but does adding .TextFrame.WordWrap = msoTrue to the block below solve your problem?
With .Shapes(.Shapes.Count)
.Width = 200
.Height = 300
End With
I think you are looking for this:
.Shapes(.Shapes.Count).TextFrame.TextRange.Text = strClip
You can set it in the same With that you are setting the height and width
If you want text to wrap within a shape, you'll have to use something other than a texteffect shape.
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.