Get Font Size List in Powerpoint VBA - vba

This code prints out every entry in the Font Size list combo box in Excel 2007 :
Sub FontSizeList()
Dim combo As CommandBarComboBox
Dim i As Integer
Dim j As Integer
For i = 1 To Application.CommandBars("Formatting").Controls.Count
If Application.CommandBars("Formatting").Controls(i).Caption = "&Font Size:" Then
Set ctl = Application.CommandBars("Formatting").Controls(i)
For j = 1 To ctl.ListCount
Debug.Print ctl.List(j)
Next j
End If
Next i
End Sub
However, when I run the same code in Powerpoint 2007 the List is Empty? How can I intialize the Font Size combo box in Powerpoint VBA? I have checked both Font Size properties 'Visible' and 'Enabled', and they are both set to True.
Thanks very much
Joe

I've tried your code on both Excel and PowerPoint 2007.
On PowerPoint, FontList and FontSize are unselectable (dark grey) if no text bloc (or drawing) is selected. That could explain why the ListCount is still 0 when debugging.
That could also explain why it does work on PPT 2003 because you do not have the ribbon and maybe FontSize and FontList are already selected.
Unfortunately, even while selecting a bloc text, i did not manage to have a ListCount > 0. I'd have to look at it further.
Max

Related

Auto fit a textbox(shape) to a text in a Word document

To give the context of my problem, I have to work with documents with text boxes, these text boxes hide the whole sentence almost all the time, so I have to resize the text box by hand so that the text is visible. The problem is that on some documents there are over 700 text boxes. Then later I've found that i can do this (Resize shape to fit text in EN) :
So I was wondering if there is a way to select all the text boxes and resize them automatically selecting this option with VBA. Thank you !
EDIT
So I've tried to start my code doing this :
Dim eShape As Word.shape
Dim i As Long
For i = ActiveDocument.Shapes.Count To 1 Step -1
Set eShape = ActiveDocument.Shapes(i)
Then I start the condition by checking the object type in this case TextBox with
If eShape.Type = msoTextBox Then
But for the rest I didn't found the method to resize the element.
Salut Satanas,
Assembled this from various bits of code found lying around several sites:
Sub AllTextBoxesAutoSize()
Dim MyShape As Shape
For Each MyShape In ActiveDocument.Shapes
If MyShape.Type = msoTextBox Then
MyShape.TextFrame.AutoSize = True
End If
Next
MsgBox ("All text boxes autosized!")
End Sub
I added the MsgBox because otherwise it's not apparent that anything's happened :-)
Bon courage!
Steve
#TimothyRylatt If you don't want to help, then just scroll by.

Unhighlighting text (and preserve all other font settings)

Thanks to 2 posts (here and here), I know how to highlight text of a textbox in PowerPoint with VBA code.
However, the problem of unhighlighting text remains unsolved. I tried to set properties of a non-highlighted textbox to TextRange2.Font (e.g. .TextFrame2.TextRange.Font.Highlight.SchemeColor = -2) but receive errors when trying so (The typed value is out of range).
Can someone help to solve this issue, please?
Additionally, when changing the highlight color
(e.g. TextRange2.Font.Highlight.RGB = RGB(255, 255, 175)) the formatting of my textbox changes, so the font is changing its color from my preset white to black and the font size gets smaller. Is there any way to preserve the original settings for the textbox? Is this happening due to the access of .TextRange2 and not .TextRange?
Thanks for your help!
In PowerPoint 2019/365 it is possible to remove highlight by using built-in Mso "TextHighlightColorPickerLicensed".
This code sample illustrates how to unhighlight text in selected shapes. It finds Runs containing highlighting, selects them and removes highlight by programmatically invoking Command Bar "Highlight" button.
Preconditions: PowerPoint 2019 or 365. Presentation must be opened with window.
Option Explicit
Sub UnhighlightTextInSelectedShape()
Dim sh As Shape
For Each sh In ActiveWindow.Selection.ShapeRange
UnhighlightTextInShape sh
Next
End Sub
Sub UnhighlightTextInShape(sh As Shape)
On Error GoTo Finish
Dim highlightIsRemoved As Boolean
Dim tf As TextFrame2
Set tf = sh.TextFrame2
Do
Dim r As TextRange2
highlightIsRemoved = True
For Each r In tf.TextRange.Runs
If r.Font.Highlight.Type <> msoColorTypeMixed Then
' Indicate that text contains highlighting
highlightIsRemoved = False
' The text to un-highlight must be selected
r.Select
If Application.CommandBars.GetEnabledMso("TextHighlightColorPickerLicensed") Then
' This Mso toggles highlighting on selected text.
' That is why selection must contain highlight of the same type
Application.CommandBars.ExecuteMso ("TextHighlightColorPickerLicensed")
' Unhighlighting May invalidate number of runs, so exit this loop
Exit For
Else
Exit Do
End If
End If
Next
Loop Until highlightIsRemoved
Finish:
If Not highlightIsRemoved Then
MsgBox "Unhighlighting is not supported"
End If
End Sub
Sometimes Application.CommandBars.ExecuteMso() method gives access to features not available via PowerPoint API.
The MsoId is displayed in tooltip text in PowerPoint options window:

How to change an existing Tabstop in PowerPoint by VBA?

I have a VBA Code to resize objects in PowerPoint including Font size, margins and everything else. But I haven’t found a solution to update/change an existing TapStop. There is a the Ruler Object with different levels und a default value. I double checked also the TextRange Object with Characters.
Are there any ideas to update the TabStop size?
Here is an example of a TextBox, i would like to resize:
TextBox Example
Shape.textframe.ruler.tabstops.count is always 0, if I "take" just the shape by For-Each-Loop. If I select it manual, it's also 0 at the sub menu TabStops of Paragraph menu.
If I click inside the shape (blinking cursor) and open the TabStops menu again, I see one TabStopPosition.
How can I access this information by VBA?
I tried it already by Line.Selection and nothing works.
Thanks!
Moe
PowerPoint used to allow only one set of paragraph settings per textframe (ie, per shape). That changed in PPT2007; now each paragraph can have its own tab and other settings. Have a go with this:
Sub ShowMeTabs()
Dim X As Long
Dim lTabCount As Long
With ActiveWindow.Selection.ShapeRange(1).TextFrame2.TextRange
For X = 1 To .Paragraphs.Count
Debug.Print X
With .Paragraphs(X).ParagraphFormat
For lTabCount = 1 To .TabStops.Count
Debug.Print .TabStops(lTabCount).Position
Next ' Tab
Debug.Print "Level:" & .IndentLevel & " Position:" & .LeftIndent 'etc
End With
Next ' paragraph x
End With
End Sub

MS Word 2003 VBA Deleting a graphic object

I have a macro that generates a case label for a list of different products. Some of the products are sterile and require a drawing of a circle to be placed on the label as a location for a radiation indicator dot. There is also a text box inside the circle that labels the circle as the location for the dot. I tried to do this by inserting an autoshape of a circle and making it a bookmark and then using the code:
ThisDocument.Bookmarks("GammaDot").Range.Delete
to delete the circle on all the parts that aren't sterile. This code works to delete the text from the text box inside the circle, but the circle itself doesn't get deleted.
It also seems that the text box itself isn't getting deleted, just the text inside the box. Does the bookmarks.Delete command not work on actual obects? and if it doesn't, how would I go about deleting the circle and text box?
Thank you
I suspect you will have to either delete the shapes by name or in a loop. The bookmark parent returns the document, not the textbox. This will delete both the textbox and the circle:
For i = ThisDocument.Shapes.Count To 1 Step -1
''Debug.Print ThisDocument.Shapes(1).Name
ThisDocument.Shapes(i).Delete
Next
You can get hold of the shapes belonging to a bookmark using the ShapeRange property of the bookmark's Range, and the shape's text using its TextFrame:
Dim bkmk As Bookmark
Set bkmk = ActiveDocument.Bookmarks("circle")
Dim shp As Shape
Set shp = bkmk.Range.ShapeRange.Item(1)
Debug.Print shp.TextFrame.TextRange.Text
shp.Delete
Deleting the shape will also remove the contained text.
You can delete everything except text and its formatting by running following code in vba editor:
Sub DeleteAllExceptText()
Dim i As Integer
With ActiveDocument
For i = .Tables.Count To 1 Step -1
.Tables(i).Delete
Next i
End With
Dim j As Integer
With ActiveDocument
For j = .Shapes.Count To 1 Step -1
.Shapes(j).Delete
Next j
Dim k As Integer
With ActiveDocument
For k = .InlineShapes.Count To 1 Step -1
.InlineShapes(k).Delete
Next k
End Sub

Entering information into the Notes section of a PowerPoint slide using VBA

I am trying to find out how you write VBA to enter a text box into a slide, and enter text. I am also trying to find vba for entering text into the notes section of a PowerPoint slide.
Any help would be greatly appreciated. I have tried to find a site specifically for this, but have not been able to do so
Entering text into a PPT slide is about the same as entering into the notes section.
You have to start out with a Slide object reference, which represents the slide you're adding to; and you add a text box shape to the slides' shapes collection.
Example:
Sub AddTextBoxToSlide()
Dim oDestSlide As PowerPoint.Slide
Set oDestSlide = ActivePresentation.Slides(1)
Dim slideWidth As Single
Dim slideHeight As Single
slideWidth = oDestSlide.Parent.PageSetup.SlideWidth
slideHeight = oDestSlide.Parent.PageSetup.SlideHeight
Dim oTextBox As PowerPoint.Shape
Set oTextBox = oDestSlide.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=0, _
Top:=0, _
Width:=slideWidth, _
Height:=slideHeight / 12)
oTextBox.TextFrame.TextRange.Text = "Shape text here"
End Sub
All this does is adds a text box shape to the first slide in the active presentation at the top of the slide. It is as wide as the slide and 1/12th the height of the slide. The parameters for Shapes.AddTextbox() are pretty self-explanatory...
To add to the notes section, I just use the NotesPage object on the slide your notes page is in...so the above code would be about the same, except:
Set oTextBox = DestSlide.NotesPage.Shapes.AddTextbox(msoTextOrientat...
This is an old question, but since you can't record macros in PowerPoint, people will be searching for questions like this until you can.
I didn't need this for adding text to slides, but I tried it for adding text to Notes. However, in Outline View, nothing appeared in my Notes section. It wasn't until I went to View-->Notes Page, and I saw the message I'd added -- at the top of the screen.
You see, when you change Set oTextBox = oDestSlide.Shapes to Set oTextBox = oDestSlide.NotesPage.Shapes, you're not adding text to the Notes. You're adding a textbox to the notes. And that textbox appears only in Notes Page view (at the top of the screen, until you move it).
What we really want to do is add our text to Placeholder 2 (the notes area) on the notes page, like this:
oDestSlide.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.InsertAfter "Notes text here"