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.
Related
I received a PowerPoint file with multiple slides which were supposed to be templates (designs - customlayouts) but instead were regular slides.
Transforming them into SlideMaster and custom layouts and replacing the titles and bodys (textboxes) with actual placeholders by hand was a pain.
So I came with this script to make the process faster.
If anybody has a better approach, it's welcome.
Had to look for a workaround to get the customlayout object.
Several things are missing, for example error handling.
To test it, copy a textbox into a slidemaster layout slide, select it and run the ReplaceWithPHTitle macro
Option Explicit
Public Sub ReplaceWithPHTitle()
ReplaceTexboxWithPlaceholder ppPlaceholderTitle
End Sub
Public Sub ReplaceWithPHBody()
ReplaceTexboxWithPlaceholder ppPlaceholderBody
End Sub
Private Sub ReplaceTexboxWithPlaceholder(ByVal placeholderType As PpPlaceholderType)
Dim targetLayout As CustomLayout
Dim activeShape As Shape
Dim newPlaceHolder As Shape
Set activeShape = ActiveWindow.Selection.ShapeRange(1)
Set targetLayout = activeShape.Parent
Set newPlaceHolder = targetLayout.Shapes.AddPlaceholder(Type:=placeholderType, Left:=activeShape.Left, Top:=activeShape.Top, Width:=activeShape.Width + 15, Height:=activeShape.Height)
With newPlaceHolder.TextFrame
.TextRange.Font.Name = activeShape.TextFrame.TextRange.Font.Name
.TextRange.Characters.Font.Color.RGB = activeShape.TextFrame.TextRange.Characters.Font.Color.RGB
.TextRange.Font.Size = activeShape.TextFrame.TextRange.Font.Size
.TextRange.Font.Bold = activeShape.TextFrame.TextRange.Font.Bold
.TextRange.ParagraphFormat.Bullet.Type = activeShape.TextFrame.TextRange.ParagraphFormat.Bullet.Type
.TextRange.ParagraphFormat.SpaceWithin = activeShape.TextFrame.TextRange.ParagraphFormat.SpaceWithin
.TextRange.ParagraphFormat.Alignment = activeShape.TextFrame.TextRange.ParagraphFormat.Alignment
.TextRange.ParagraphFormat.SpaceBefore = activeShape.TextFrame.TextRange.ParagraphFormat.SpaceBefore
.TextRange.ParagraphFormat.SpaceAfter = activeShape.TextFrame.TextRange.ParagraphFormat.SpaceAfter
.TextRange.ParagraphFormat.BaseLineAlignment = activeShape.TextFrame.TextRange.ParagraphFormat.BaseLineAlignment
.TextRange.Text = activeShape.TextFrame.TextRange.Text
End With
With newPlaceHolder.TextFrame2
.TextRange.Font.Spacing = activeShape.TextFrame2.TextRange.Font.Spacing
End With
newPlaceHolder.ZOrder msoSendToBack
newPlaceHolder.Select
End Sub
Any improvements are welcome too.
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
.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've read a few forums but none of them seem to be working for me.
I'm pulling pictures from the web, and inserting them into my spreadsheet. I'd like all of these pictures to have the same dimension.
My code is as follows:
Dim img_url as string, picture as object
img_url = Range("A1") 'Some url with an img
With ActiveSheet.Pictures
Set Picture = ActiveSheet.Pictures.Insert(img_url)
Picture.LockAspectRatio = msoFalse
Picture.Width = 25
PictureHeight = 25
End With
Every time I run it, the Lock Aspect Ratio setting is still checked, and the image is not in the square format I'm looking for.
Any advice would be much appreciated.
Thanks
Use the code below, the LockAspectRatio attribute is a property of the Picture.ShapeRange object, and not the Picture.
Option Explicit
Sub ImageAttributes()
Dim img_url As String
Dim picture As Object
img_url = Range("A1") 'Some url with an img
With ActiveSheet
Set picture = .Pictures.Insert(img_url)
With picture
With .ShapeRange
.LockAspectRatio = msoFalse
.Width = 25
.Height = 25
End With
End With
End With
End Sub
the title pretty much says it all, but to make it a little more clear, say I want to create a text box via VBA that says "This text should be of font size 24, this text should be of font size 20."
Right now, I'm using my own function to create the text box, which is below. Cheers, and thanks for the help!
Sub textBox(textBoxText As String)
Dim myTextBox As Shape
With ActiveWindow.Selection.SlideRange
Set myTextBox = .Shapes.AddTextbox _
(Orientation:=msoTextOrientationHorizontal, Left:=153, Top:=50, _
Width:=400, Height:=100)
myTextBox.TextFrame.TextRange.Text = textBoxText
myTextBox.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignCenter
myTextBox.TextFrame.TextRange.Font.Bold = msoTrue
myTextBox.TextFrame.TextRange.Font.Name = "Arial (Headings)"
End With
End Sub
A RichTextBox is not needed. The answer lies in the properties of the TextRange object within the TextFrame of the TextBox (what a mouthful!). Basically, you can parse/traverse the text within this range object and, if you make selections based on paragraphs (or sentences, words, characters, etc) you can apply different text effects.
Sub CreateTextbox()
Dim MyTextBox As Shape
Dim textBoxText As String
Dim textToChange As TextRange
textBoxText = "this is some wild text"
With ActiveWindow.Selection.SlideRange
Set MyTextBox = .Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
Left:=153, Top:=50, Width:=400, Height:=100)
MyTextBox.TextFrame.TextRange.Text = textBoxText
MyTextBox.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignCenter
MyTextBox.TextFrame.TextRange.Font.Bold = msoTrue
MyTextBox.TextFrame.TextRange.Font.Name = "Arial (Headings)"
# here's where the magic happens
Set textToChange = MyTextBox.TextFrame.TextRange
textToChange.Words(3).Select
textToChange.Words(3).Font.Size = 42
End With
End Sub
Get the text range reference and then assign the desired font size.
With myTextBox.TextFrame2.TextRange
With .InsertAfter("This text should be of font size 24,")
.Font.Size = 24
End With
With .InsertAfter("this text should be of font size 20")
.Font.Size = 20
End With
End With