I develop a VBA add-in for PowerPoint which can insert a table into a slide. I set the font family for the table's header cells to the ones defined in the theme fonts. I want it to change when I switch to another theme font.
However, if I use the following code the font will be "pinned" to the font family name of the theme's major font and does not change when I change the theme fonts.
Sub FormatTable(table As table)
Dim headerFont As ThemeFont
Set headerFont = ActivePresentation.SlideMaster.Theme.ThemeFontScheme.MajorFont(1)
For Each c In table.Rows(1).Cells
c.shape.TextFrame.TextRange.Font.Name = headerFont.Name
Next c
End Sub
How do I have to rewrite the code to keep the font exchangeable via theme changes?
' Theme fonts have special names
'Body font, Latin (ie main) +mn-lt
'Heading Font, Latin + mj - lt
'Body Font, Eastern + mn - ea
'Heading Font, Eastern + mj - ea
'Body font, complex scripts +mn-cs
'Heading font, complex scripts +mn-cs
Sub FormatTable(table As table)
Dim headerFont As ThemeFont
Dim c As Cell
Set headerFont = ActivePresentation.SlideMaster.Theme.ThemeFontScheme.MajorFont(1)
For Each c In table.Rows(1).Cells
' This sets the font to whatever the NAME of the theme font is
' c.Shape.TextFrame.TextRange.Font.Name = headerFont.Name
' This sets it to the actual theme font:
c.Shape.TextFrame.TextRange.Font.Name = "+mn-lt"
' And after running the code, you'll see that the font
' is set to e.g. Calibri (Body) rather than just Calibri
Next c
End Sub
Related
I wrote the following macro for MS Word. It works sometimes, but not consistently. I would love some help identifying what the problem might be with the code. Thanks in advance.
The macro should perform the following tasks.
In a paragraph containing English text and non-English text:
Apply the Arabic font (Noto Naskh Arabic UI) to each instance of non-English text
Set each instance of non-English text to 18-point font size
In a paragraph containing only non-English text:
Apply the Arabic font (Noto Naskh Arabic UI) to each instance of non-English text
Set each instance of non-English text to 18-point font size
Right-align the entire paragraph
Issues
Non-English text doesn’t change font size in either scenario.
The right-alignment isn’t consistently applied in the second scenario.
Sub Arabic()
For Each myPara In ActiveDocument.Paragraphs
If myPara.Range.LanguageID = 9999999 Then
For Each myWord In myPara.Range.Words
If myWord.LanguageID <> wdEnglishUS Then
myWord.Font.Name = "Noto Naskh Arabic UI"
myWord.Font.Size = 18
Else
myWord.Font.Name = "Times New Roman"
End If
Next myWord
ElseIf myPara.Range.LanguageID <> wdEnglishUS Then
myPara.Range.Font.Name = "Noto Naskh Arabic UI"
myPara.Range.Font.Size = 18
myPara.Alignment = wdAlignParagraphRight
End If
Next myPara
End Sub
I'm a very novice programmer (think code-enthusiastic English major) trying to do something that I think should be very straightforward. For work I have to incorporate materials from multiple Word-using sources, all of whom have different settings for various styles. So Alan will have Heading 1 be, for example, 14 pt Arial, while Beth's Heading 1 will be 16 pt Courier New, and the standard for my org for Heading 1 is 18 pt Calibri. The different styles can quickly pile up, and even if you change the imported materials to fit what is correct, there's a bunch of material in there that can cause issues.
What I'd like is to build a VBA macro that runs through the document and essentially says, "this is Body? Cool, all Body text is set to these settings. This is Heading 1? All Headings 1 should be XYZ," and then goes through and does those conversions. I got an O'Reilly book on writing macros for Word, but I quickly got in over my head. Any suggestions on how to start, or where to look?
Thanks in advance.
ETA
My code is now at this point:
Sub test()
Set objDoc = ActiveDocument
' First, highlight the entire document in the default color (i.e. the color to use for styles that aren't defined in our guide)
objDoc.Range.HighlightColorIndex = wdDarkYellow
' Need to figure out how to do color code (RGB) this works for now.
reformatStyle "Heading 1", False, "Calibri", wdBlack, 16
reformatStyle "Body"
' Call reformatStyle once for each style, setting the appropriate values for bold, fontName, color and size.
' valid colors are at https://learn.microsoft.com/en-us/office/vba/api/word.wdcolorindex
End Sub
Sub reformatStyle(style, bold, fontName, color, fontSize)
With objDoc.Content.Find
.ClearFormatting
.style = style
' this first bit selects the blocks that have the specified style
With .Replacement
.Font.bold = bold
.Font.Name = fontName
.Font.ColorIndex = color
.Font.Size = fontSize
.Highlight = False
' this modifies the selected blocks. Note that we remove the highlighting at this point, otherwise it would remain at the default color
End With
.Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceAll
End With
End Sub
What I'd like to do is be able to set the color to RGB values. Any suggestions?
I would like to set font type (calibri)of text( where ever there is an alphabet in presentation, it should be "calibri") in every slide by running the single macro using VBA. The problem is, it is unable to change the font present in 'chart', 'flow chart diagram' where it has boxes like rectangle, round cornered rectangles etc.How to manipulate that text as well? Please help!
As shown in the image the font of climate in rectangle is not changing.Different font type in rectangle
The solution to this problem is pretty tedious as there are so many different types of shapes and textranges to account for. I can't post my entire solution as I don't own the intellectual property, but this should get you on the right track:
Sub MakeFontsThemeFonts()
Dim oSld As Slide
Dim oShp As Shape
Dim oShp2 As Shape
Dim oTxtRange As TextRange
' Set majorFont and minorFont to Calibri
ActivePresentation.SlideMaster.Theme.ThemeFontScheme.majorFont.Item(1) = "Calibri"
ActivePresentation.SlideMaster.Theme.ThemeFontScheme.minorFont.Item(1) = "Calibri"
For Each oSld in ActivePresentation.Slides
For Each oShp in oSld.Shapes
If oShp.HasChart Then
' Call your chart handler
ElseIf oShp.HasTable Then
' Call your table handler
ElseIf oShp.HasSmartArt Then
' Call your SmartArt handler
ElseIf oShp.HasTextFrame Then
If oShp.HasText Then
Set oTxtRange = oShp.TextFrame.TextRange
Call RefontTextRange (oTxtRange)
End If
ElseIf oShp.Type = msoGroup Then
For Each oShp2 in oShp.GroupItems
If oShp2.Type = ... Then
' And so on, you wind up having to check for
' everything that's grouped all over again
End If
Next
End If
Next
Next
End Sub
Sub RefontTextRange (oTxtRange As TextRange)
With oTxtRange.Font
' Sets the textrange to the body font. If you want to make some stuff the heading font and some stuff the body font, you need to do more checking before sending here
.Name = "+mn-lt"
End With
End Sub
So that's the start of the solution, but this will get maddening for a few reasons. For tables, you'll have to parse the TextRange of every cell individually and pass those TextRanges on to your Refont sub. For charts, you may have to check for every imaginable chart element before setting your TextRange and refonting (my case was more complex than just setting the font to be the theme font, and I didn't have success trying to format the ChartArea all at once).
Are you having the issue with "floating" shapes inside of a chart? When you say "flow chart," is that an embedded Visio diagram or native SmartArt? There are many ways to skin this cat, but the solution will require you to identify every possible type of text container that can be accessed using VBA.
Here's one more tip that might help you get at those floating shapes within charts:
oShp.Chart.Shapes(1).TextFrame.TextRange.Font.Name = "+mn-lt"
But of course first you need to make sure you've got a chart, that it's got shapes in it, that those shapes have a textframe...
If you leverage the features already built in to PowerPoint, you won't need any code at all. The font theme is built to handle these situations. Format all text with font choices that include the (body) or (headings) tag in the name. Then when you switch the font theme from Arial to Calibri, all text, including charts and SmartArt, will be updated.
For a presentation that is already formatted with local formatting instead of using a font theme, unzipping the file to XML and using a good text editor's Find and Replace functions, you can quickly replace all instances of a font without programming.
Find 'typeface="Arial"'
Replace 'typeface="Calibri"'
Then rezip the files and restore the file ending.
It seems you only need to change the master slides (including notesmaster, slidemaster), instead of working on each slide. Here are my codes
Sub ChangeFont()
' https://stackoverflow.com/a/57212464/2292993
' affect SmartArt font
ActivePresentation.SlideMaster.Theme.ThemeFontScheme.majorFont.Item(1) = "Garamond"
ActivePresentation.SlideMaster.Theme.ThemeFontScheme.minorFont.Item(1) = "Garamond"
For i = 1 To Application.ActivePresentation.NotesMaster.Shapes.Count
With Application.ActivePresentation.NotesMaster.Shapes(i).TextFrame.TextRange.Font
.Name = "Garamond"
If Application.ActivePresentation.NotesMaster.Shapes(i).Name Like "Notes*" Then
.Bold = msoFalse
.Size = 16
End If
End With
Next i
' http://skp.mvps.org/2007/ppt003.htm
' Each design contained a slide master and possibly a title master. Several designs could be stored within a presentation.
' The slide master can contain several custom layouts which can be fully customized.
For Each oDesign In ActivePresentation.Designs
' slide master
Set sm = oDesign.SlideMaster
For j = 1 To sm.Shapes.Count
If sm.Shapes(j).HasTextFrame Then
With sm.Shapes(j).TextFrame.TextRange.Font
.Name = "Garamond"
End With
End If
Next j
' custom layouts
lngLayoutCount = oDesign.SlideMaster.CustomLayouts.Count
For I = 1 To lngLayoutCount
Set oCL = oDesign.SlideMaster.CustomLayouts(I)
For j = 1 To oCL.Shapes.Count
If oCL.Shapes(j).HasTextFrame Then
With oCL.Shapes(j).TextFrame.TextRange.Font
.Name = "Garamond"
End With
End If
Next j
Next I
Next
End Sub
I am on Libre Office 6.0. I generated a macro to change the font color of selected text to 'Blue 3'. It works fine.
What I want the macro to do is select the entire document and change the font color to 'Blue 3' for any blue text that is some other color of blue.
The issue is that I converted some documents and the hyperlinks are blue but an off-color of blue. Highlighting and correcting multiple hyperlinks surrounded by black text is a laborious process.
sub ChangeToBlue3
dim document as object
dim dispatcher as object
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "Color"
args1(0).Value = 255
dispatcher.executeDispatch(document, ".uno:Color", "", 0, args1())
end sub
I am trying to use VBA to insert some text into a PowerPoint TextRange, I use something like this:
ActiveWindow.Selection.SlideRange.Shapes("rec1").TextFrame.TextRange.Text = "Hi"
However, I can't figure out how to apply bold, italic and underline programmatically (I don't see a .RichText property or something similar).
What I have is some simple HTML text with bold, italic and underlined text I would like to convert over.
How to do this?
This is easily accomplished by using the TextRange's Characters, Words, Sentences, Runs and Paragraphs objects and then it's Font object to set Bold, Underline and Italic (amongst other properties). For example:
Sub setTextDetails()
Dim tr As TextRange
Set tr = ActiveWindow.Selection.SlideRange.Shapes(1).TextFrame.TextRange
With tr
.Text = "Hi There Buddy!"
.Words(1).Font.Bold = msoTrue
.Runs(1).Font.Italic = msoTrue
.Paragraphs(1).Font.Underline = msoTrue
End With
End Sub
Try looking at MSDN's documentation on the TextRange object. It contains samples of how to access the Font properties of the TextRange object.
EDIT: You can access things like Bold and Italics programmatically in this manner:
TextRange.Font.Bold = msoTrue
EDIT EDIT: There are several methods by which you can select only certain text in a text range. See the following:
Characters Method
Lines Method
Paragraphs Method
Words Method
According to the sames from this link, you can select a portion of the text using one of these methods and set the font programmatically. For example:
Application.ActiveDocument.Pages(1).Shapes(2) _
.TextFrame.TextRange.Words(Start:=2, Length:=3) _
.Font.Bold = True
That example was taken from the Words Method link.
In addition to the above answer, you should try to name the objects you'll be changing, since selecting them in the middle of a presentation could make PowerPoint act oddly. Create a new TextRange object and set it like this.
dim mytextrange As TextRange
Set mytextrange = ActiveDocument.Pages(1).Shapes(2).TextFrame.TextRange
mytextrange.Words...
Here is how you can do it to change the font of a specific text:
Sub changeFont()
Dim oPresentation As Presentation
Dim oSlide As Slide
Dim oShape As Shape
Dim stringSearched As String
stringSearched = "something"
'all opened presentations
For Each oPresentation In Presentations
'all slide in them
For Each oSlide In oPresentation.Slides
'all shapes (anything)
For Each oShape In oSlide.Shapes
'only those that contain text
If oShape.HasTextFrame Then
If InStr(oShape.TextFrame.TextRange.Text, stringSearched) > 0 Then
'here you need to define where the text ends and start
oShape.TextFrame.TextRange.Characters(InStr(oShape.TextFrame.TextRange.Text, stringSearched), Len(stringSearched)).Font.Underline = msoTrue
oShape.TextFrame.TextRange.Characters(InStr(oShape.TextFrame.TextRange.Text, stringSearched), Len(stringSearched)).Font.Italic = msoFalse
End If
End If
Next
Next
Next
End Sub