I am coding using PowerPoint VBA and am trying to place text inside a rectangle shape, but ensure that the text fits (so there is no overflowing). I do not want the shape itself to resize, but the text to resize.
I have seen that I can use
oShp.TextFrame2.AutoSize = msoAutoSizeTextToFitShape
However, the problem with this is that the text will only resize after the user has clicked on the textbox when PowerPoint is in normal mode. I want this functionality when the PowerPoint is running!
I would be grateful to know is there a way to get the text automatically resized or do I need to find an alternative method?
Thank you for any comments!
I thought I would answer my question and close the thread.
After doing much research I found that there was no apparent method to get the text to auto-resize itself when the PowerPoint Show runs. I tried a number of approaches e.g. inserting text, trimming the text and turning word wrap off and on - however, none of these worked. I note (Bhavesh) I was fully aware of how to select the auto-size text settings via PowerPoint's GUI.
In the end my solution was to make a do loop and change the size of the text.
Below I pasted my key lines in the hope that it might help someone else who is trying to do the same. I made a variable overflow which attempts to assess if the height of the shape's textbox is bigger than the size of the rectangle.
Dim overflow As Integer
Dim counter As Integer
counter = 0
With ActivePresentation.Slides(i).Shapes(stringToTest)
overflow = CInt((.TextFrame.TextRange.BoundHeight) - (.Height - .TextFrame.MarginTop - .TextFrame.MarginBottom))
Do While overflow > 16 And counter < 50
'*** I note that the shape is overflowing when its value is >0 but I found 16 to be the most "aesthetically pleasing" number!
'*** Also using a counter prevents the code from potentially getting stuck in an infinite loop
If .TextFrame.TextRange.Font.Size > 20 Then
.TextFrame.TextRange.Font.Size = .TextFrame.TextRange.Font.Size - 1
Else
.TextFrame.TextRange.Font.Size = .TextFrame.TextRange.Font.Size - 0.5
End If
'**** By reducing the font size by 0.5 this provided a better fit for the text _
'**** (even better than using on PowerPoint's auto-size function!)
counter = counter + 1
overflow = CInt((.TextFrame.TextRange.BoundHeight) - (.Height - .TextFrame.MarginTop - .TextFrame.MarginBottom))
Loop
End With
In shape format, under text options, choose the option to shrink text on overflow.
Then, using .Shapes("Title 1").TextFrame.TextRange we input text via VBA.
The text automatically changes its font size.
Related
I'm trying to automate the process of changing the height in the Slide Size dialog in the Slide Master system with VBA. When I try to change it, VBA informs me that I'm not permitted to assign a value to ActivePresentation.SlideMaster.Height because it is read-only.
I've studied the ActivePresentation object tree and have figured out to acquire the height value (with ActivePresentation.SlideMaster.Height), but the following line results in a Compile Error:
ActivePresentation.SlideMaster.Height = 1189
Changing the SlideHeight with...
ActivePresentation.PageSetup.SlideHeight = 1189
does change the height of the slide, but it doesn't have the same effect as changing the height through the Slide Master system. The primary question at this stage is if it's possible to change ActivePresentation.SlideMaster.Height with VBA, or is the Read-Only status immutable?
Sub test()
ActivePresentation.SlideMaster.Height = 1189 'Compile Error...can't assign to read-only property
ActivePresentation.PageSetup.SlideHeight = 1189 'Changes the height of the slides, _
but doesn't change the size of text within Shape elements like I need it to do.
End Sub
Here's some background...
Through a bit of trial and error, I've determined that if I change the dimensions of the slides using the slide master, the default text for Shapes is set how I want it (at pitch 18). If I don't change the dimensions in the Slide Master, the text for Shapes remains at 31. Even if a new shape is created, the font is changed to 18 and that shape is set as the default shape, if text is pasted onto the slide (with CTRL-v or Paste Special-Unformatted Text), the shape that gets created has a text-size of 31.
Just to be clear, if the default is set to 18 and I create another new Shape via Insert>Shapes, then that new shape is automatically set to 18. It's only when I paste text (using either CTRL-v or Paste Special - Unformatted) directly on the slide does it become 31.
The only thing that does what I want is making a slight change to the Slide Master Slide Size. Changing the height from 1188 to 1189 forces all of the shapes on all of the slides to go from 31 to 18. Any new text that gets pasted in the slide comes in as a shape containing 18 text.
The reason I'm posting this on Stack Overflow and not on Super User is because I have to automate this change...we have thousands of presentations to modify.
I wrote some macro code in Word (Office 365) to set the color of a shape outline to one of the theme colors. The code for doing that to a shape looks like this:
shape.line.foreColor.ObjectThemeColor = wdThemeColorAccent2
By assigning a 'wdXX' color to the ObjectThemeColor field, the color of the line around the shape will automatically change when the document ColorTheme is changed.
My problem (or the first weirdness) is that when I assign Accent2 with the code above and then do: select the shape, Menu, Format, Shape Outline, and hover over the color box with a red outline (which marks the active line color), the tooltip says "Turquoise, Accent 1" not "Accent 2."
I would have expected the wdThemeColorAccent2 color to be called Accent 2 in the tooltip, but it is not.
The second problem is that there is apparently no way for me to assign the last color shown in the menu using macro code. Because of the offset (Accent 2 in code = Accent 1 in the menu), I would need to use wdThemeColorAccent7 in code to assign the last color shown in the menu (labeled Accent 6 in the tooltip).
I'm wondering if this is a bug in Word (it sure looks like it to me), or if I am doing something wrong. To reproduce the situation, I created a simple empty rectangle, selected it, and ran the line of code above to change the outline color of the shape. Here's a little subroutine that illustrates the problem (select your shape before running the subroutine).
Sub TestAccent()
Dim shp As Shape
Set shp = selection.ShapeRange(1)
shp.line.foreColor.ObjectThemeColor = wdThemeColorAccent4
shp.line.Weight = 0.5
shp.line.Visible = True
End Sub
I believe the colors in the "theme scale" (see image below) don't correspond to the names of the WdThemeColorIndex, but rather to the underlying numerical value. If you look in the VBA Editor's Object Browser (F2), and search wdThemeColorAccent you'll get the full list. Click on a member in the list and at the bottom you'll see the numerical value.
The value 0 is assigned to MainDark1 and isn't recognized by VBA. Values 1, 2 and 3 are assigned to MainLight1, MainDark2 and MainLight2 which are black, white and the first entry in the image (These colors repeat in the last four enumerations for background and text). Values 4 (wdThemeColorAccent4) through 9 (wdThemeColorAccent6) correspond to the remainder of the colors in the image below. (Note: more discussion after image!)
So, no, I don't think it's a bug, just your expectations don't match what the developers were thinking when they assigned the numerical enumeration to the enumeration names. Or maybe the people who designed the color schemes changed their minds after the VBA code was locked down... And I imagine the names you see in the tooltips are another step removed from the VBA. You might find the information in this article helpful.
If you use the values, rather than the names, things could be less confusing. Or, define your own Enum:
Public Enum ColorSchemeAccents
Accent1 = 3
Accent2 = 4
Accent3 = 5
Accent4 = 6
Accent5 = 7
Accent6 = 8
Accent7 = 9
Accent8 = 10
End Enum
Sub TestAccent()
Dim shp As Shape
Set shp = Selection.ShapeRange(1)
shp.Line.ForeColor.ObjectThemeColor = ColorSchemeAccents.Accent8
shp.Fill.ForeColor = RGB(250, 250, 250)
shp.Line.Weight = 2
shp.Line.Visible = True
End Sub
Although the ColorFormat object's .ObjectThemeColor is defined as a wdThemeColorIndex in fact the value depends on context.
If it is a Word object - such as text, then you should use the wdThemeColorIndex constants, but if it is an Office object - such as shape, then you have to use the msoThemeColorIndex constants. These are weirdly NOT the same - mostly the mso constants are one more than the wd constants, but not for the Background1&2 and Text1&2 cases - Text1&2 are the same in both cases, but for Background1&2 mso is two more than wd.
A side effect of this is that it appears impossible in VBA to set the Background2 colour, as its mso value is 16 and so out-of-range BUT if you use the native GUI to set it, it can be set to 16!
Looks really poor design/implementation that needs cleaning up!
Is there a way to count number of rows of texts inside a Visio shape? Such as linecount?
I've tried Rowcount on a Visio shape and it didn't return anything reflecting the text lines inside the Visio Shape! Below is that sample code I created
Sub something()
Dim intRows
Dim vsoShape As Visio.Shape
Set vsoShape = ActiveWindow.Selection.PrimaryItem
intRows = vsoShape.RowCount(Visio.visSectionProp)
MsgBox intRows
End Sub
There is no built-in way to count the number of lines of text, that I'm aware of.
The RowCount is for counting the number of rows in a particular shapesheet section.
You can call the BoundingBox method on a shape and get back the height and width of the text area for the shape, but you'd have to guess at how many lines that is, maybe as a function of the font size.
If you are able to enforce a standard font and character size on shapes in the diagrams you're working with, you should be able to tell how many lines there are based on the height of the text box.
I'm assuming you're asking after the number of line wraps that Visio has done, not the number of line breaks in the text.
I have a large macro that generates and populates a table in powerpoint based on excel values. I manually resize the rows based on specific parameters, but I've run into the very annoying issue that I cannot seem to prevent the rows from auto-resizing if the text would overflow from that particular cell. I've tried using the textframe and textframe2 "autosize" property but this gives an error on the first call saying that the specified value is out of range. The error number is -2147024809 (80070057), although I doubt that will be of any use. Is there a way to prevent this autosizing beyond writing code to manually shorten the text when it will overflow?
RGA,
the answer to your question is yes; you can do this. This topic is discussed in the following thread: Understanding format of tables in PowerPoint (VBA 2010) (resize text to cell)
However, I don't know if this technique still 'works' for ppt 2016. I had such code implemented, and then I 'upgraded' to office 2016; now it doesn't work.
With that being said, this was my code (resized the text until it 'fit'):
...
Do Until (table.rows(1).height + table.rows(2).height < TABLE_HEIGHT) or (table.Cell(2, 2).Shape.TextFrame.TextRange.Font.size = 1)
If table.Cell(1, 1).Shape.TextFrame.TextRange.Font.size = 1 Then
table.Cell(1, 1).Shape.TextFrame.TextRange.Font.size = 27
table.Cell(2, 2).Shape.TextFrame.TextRange.Font.size = table.Cell(2, 2).Shape.TextFrame.TextRange.Font.size - 1
table.Cell(2, 3).Shape.TextFrame.TextRange.Font.size = table.Cell(2, 2).Shape.TextFrame.TextRange.Font.size
Else
table.Cell(1, 1).Shape.TextFrame.TextRange.Font.size = table.Cell(1, 1).Shape.TextFrame.TextRange.Font.size - 1
End If
Loop
In order to restore some functionality in ppt 2016, I decided to rewrite my code to limit the number of lines shown to prevent the 'resize' table call:
...
table.Cell(1, 1).Shape.TextFrame.TextRange = table.Cell(1, 1).Shape.TextFrame.TextRange.lines(1,2)
table.Cell(2, 2).Shape.TextFrame.TextRange = table.Cell(2,2).Shape.TextFrame.TextRange.lines(1,1)
table.Cell(2, 3).Shape.TextFrame.TextRange = table.Cell(2, 3).Shape.TextFrame.TextRange.lines(1,1)
In theory, you can use the .height; .Textrange; and the height of your font to figure the size of font you need inorder to 'shrink' the text to fit.
What do you want to happen when there is too much text to fit into a cell? There is no UI concept in PowerPoint to prevent row auto resizing based on cell overflow as there is nowhere for the additional text to go as demonstrated by typing in a cell within PowerPoint. Therefore there is no API to do the same. I would record the row before and after inserting the text and truncate word by word as you say until the row height returns to the original value.
Using interop.powerpoint in VB.Net I am inserting an EMF file with the code:
' add picture shape to slide
AvailableSlide.Shapes.AddPicture(FileName:=file, LinkToFile:=MsoTriState.msoFalse, _
SaveWithDocument:=MsoTriState.msoTrue, Left:=SlideHorizontalPosition, Top:=SlideVerticalPosition)
' save original image size
mOriginalImageWidth = CurrentShape.Width
mOriginalImageHeight = CurrentShape.Height
' if EMF then crop the bottom
CurrentShape.PictureFormat.CropBottom = mCropValue
I have the original size saved before cropping. However, if I'm using a selected image in a PPT file I didn't save, I can't figure out where the original image size is stored in the selected "shape" object (5.49" by 4.13" in the image below). I assumed it would be in the PictureFormat somewhere.
dgp
Set the shape's .ScaleHeight and .ScaleWidth to 1 to return it to the original size.
This may or may not work but it's worth a shot (I can't test because I don't have Powerpoint). After a little bit of research on the PictureFormat interface, it has a few members that might be useful to you. I didn't exactly see anything that specified the picture's original size, but there were these four properties that seemed helpful: CropLeft, CropRight, CropTop, and CropBottom. They return the number of points cropped off each side respectively. A way to get the original size of the object would be to add the Width to CropLeft + CropRight and add the Height to CropTop + CropBottom. Try that and let me know if it works. Documentation is found here: http://msdn.microsoft.com/en-us/library/microsoft.office.interop.powerpoint.pictureformat_members(v=office.14).aspx
Try getting the shape's ScaleWidth and ScaleHeight properties. I couldn't find it in the documentation, but awhile ago, I had a student work with me to create an application to format powerpoint presentations that were imported into microsoft word. Here's the code that dealt with the scale size of the shape.