.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
Related
I want to place a logo at the top right hand corner at each page in a document. This functionality is already present in a Word add-in that is managed by us. However this feature does not work correctly. The add-in converts the image to a shape and then places this image a fixed distance from the left document corner. This works for documents that are A4 formats, but whenever the orientation or size of the document changes, the logo placement is off.
I have tried numerous strategies to resolve this, but haven't found a method that is satisfactory. My current strategy is to determine the distance between the left page side and the logo dynamically and then make this position relative to the right side of the page by calling the .RelativeHorizontalPosition property and linking it to the right margin area.
Unfortunately interacting with the .Left property of the Shape object has been troublesome. The .Left property does not take on the value I assign it, but takes on a negative value. I have checked the parameter I assign it numerous times. Would anyone know why this is the case and how to resolve it?
Example Code
Private Sub AddLogos(section As Section, header As HeaderFooter)
Dim wordApp As Word.Application = Globals.ThisAddIn.Application
Dim pageWidth As Single = section.PageSetup.PageWidth
Dim imgFilePath As String = "filepath"
Dim leftDistanceA4 As Single = 11
Dim logo As Word.Shape
Try
If wordApp.ActiveDocument.SaveFormat >= 12 Then
logo = header.Range.InlineShapes.AddPicture(m_sImageLogo, False, True).ConvertToShape()
Else 'Word 97-2003 Support
logo = header.Shapes.AddPicture(imgFilePath, False, True)
End If
Catch ex As Exception
Throw New Exception("Error message.")
End Try
Dim distanceFromRightPageEdge = wordApp.CentimetersToPoints(21 - leftDistanceA4)
Dim distanceFromLeftPageEdge = pageWidth - distanceFromRightPageEdge
With logo
.RelativeVerticalPosition = WdRelativeVerticalPosition.wdRelativeVerticalPositionPage
.Left = distanceFromLeftPageEdge
.RelativeHorizontalPosition = WdRelativeHorizontalPosition.wdRelativeHorizontalPositionRightMarginArea
End With
Instead of setting the left position to an absolute value, you can make it relative and essentially "right-align" the shape. If you set the RelativeHorizontalPosition and Left properties as shown below, the image will be placed in the top-right corner, and will maintain its relative position to that corner even when the document's format or size is altered.
Const imgpath As String = "[your path]"
Dim app As New Microsoft.Office.Interop.Word.Application
Dim doc As Microsoft.Office.Interop.Word.Document = app.Documents.Add()
Dim head As Microsoft.Office.Interop.Word.HeaderFooter = doc.Sections(1).Headers(1)
Dim img As Microsoft.Office.Interop.Word.Shape = head.Shapes.AddPicture(imgpath, False, True)
With img
.RelativeHorizontalPosition = Microsoft.Office.Interop.Word.WdRelativeHorizontalPosition.wdRelativeHorizontalPositionMargin
.Left = Microsoft.Office.Interop.Word.WdShapePosition.wdShapeRight
End With
app.Visible = True
'dispose references
Edit: If you need more control over positioning than simply anchoring the image to the top-right corner of the page, inline shapes do not inherently possess that. Instead, consider using a borderless table in the header to provide more control over its contents. Once the image is a child of the table, you have access to all the table formatting controls to use on your image:
Const imgpath As String = "[your path]"
Const imgMarginCM As Integer = 2
Dim app As New Microsoft.Office.Interop.Word.Application
Dim doc As Microsoft.Office.Interop.Word.Document = app.Documents.Add()
Dim head As Microsoft.Office.Interop.Word.HeaderFooter = doc.Sections(1).Headers(1)
Dim tbl As Microsoft.Office.Interop.Word.Table = doc.Tables.Add(head.Range, 1, 1)
With tbl
.Borders.Enable = False
.AutoFitBehavior(Microsoft.Office.Interop.Word.WdAutoFitBehavior.wdAutoFitWindow)
.Cell(1, 1).Range.ParagraphFormat.Alignment = WdParagraphAlignment.wdAlignParagraphRight
.Cell(1, 1).TopPadding = app.CentimetersToPoints(imgMarginCM)
.Cell(1, 1).RightPadding = app.CentimetersToPoints(imgMarginCM)
.Cell(1, 1).Range.InlineShapes.AddPicture(imgpath, False, True)
End With
app.Visible = True
'dispose references
Of course, if you have other items in the header then you would create a table with multiple cells and adjust the spacing appropriately, but for this example I'm just putting a borderless single-cell table in the header and setting its autofit behavior to fitwindow so that the table will fill the width of the page even when margins or format are changed. Then I just set the top and right padding of the cell with the image, and the behavior you are looking for is achieved.
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 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.