#1
|
|||
|
|||
"If it's a red bolded space, highlight it" macro?
Hello!
If it's a blank space or hard return in a text box and it's red and bolded, then highlight it. (I red-bold important text, but sometimes the space before or after, or the line break gets selected and that gets red-bolded. I want to find those so I can fix them.) Is there a macro that does this? Thanks for your help! leaning |
#2
|
|||
|
|||
I attempted code based on other code I found, but it fails on the highlight line (I'm using PP 2013), and then I'm not exactly sure if ^p will find the non-printing backwards P paragraph symbol. Anyone know how to fix this?
Code:
Option Explicit Sub HighlightKeywords() 'https://stackoverflow.com/questions/15844903/find-and-highlight-text-in-ms-powerpoint Dim sld As Slide Dim shp As Shape Dim txtRng As TextRange, rngFound As TextRange Dim i As Long, n As Long Dim TargetList TargetList = Array(" ", "^p") '~~> Array of terms to search for For Each sld In Application.ActivePresentation.Slides '~~> Loop through each slide For Each shp In sld.Shapes '~~> Loop through each shape If shp.HasTextFrame Then '~~> Check if it has text Set txtRng = shp.TextFrame.TextRange For i = 0 To UBound(TargetList) Set rngFound = txtRng.Find(TargetList(i)) '~~> Find the text Do While Not rngFound Is Nothing '~~~> If found n = rngFound.Start + 1 '~~> Set the marker so that the next find starts from here If rngFound.Font.Bold = msoTrue And rngFound.Font.Color = vbRed Then rngFound.Font2.Highlight.RGB = RGB(255, 255, 0) 'yellow End If Set rngFound = txtRng.Find(TargetList(i), n) '~~> Find Next instance Loop Next End If Next Next MsgBox "Done" End Sub |
#3
|
|||
|
|||
I tried this code to find all the red-bold-spaces and replace with them with @'s so I can then go back through, search for @, and delete them one by one. It will put @'s between words instead of just looking for the spaces before and after the phrases, but it's better than nothing. But it keeps giving me a "Specified value out of range" error.
I'm stumped. Code:
Sub FindReplaceAll() 'PURPOSE: Find & Replace text/values throughout entire PowerPoint presentation 'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault Dim sld As Slide Dim shp As Shape Dim ShpTxt As TextRange Dim TmpTxt As TextRange Dim FindWord As Variant Dim ReplaceWord As Variant FindWord = " " ReplaceWord = "@" 'Loop through each slide in Presentation For Each sld In ActivePresentation.Slides For Each shp In sld.Shapes If shp.HasTextFrame Then 'Store shape text into a variable Set ShpTxt = shp.TextFrame.TextRange 'Ensure There is Text To Search Through If ShpTxt <> "" Then If ShpTxt.Font.Bold = msoTrue And oTxtRng.Font.Color = vbRed Then 'Store text into a variable Set ShpTxt = shp.TextFrame.TextRange 'Find First Instance of "Find" word (if exists) Set TmpTxt = ShpTxt.Replace( _ FindWhat:=FindWord, _ Replacewhat:=ReplaceWord, _ WholeWords:=True) 'Find Any Additional instances of "Find" word (if exists) Do While Not TmpTxt Is Nothing Set ShpTxt = ShpTxt.Characters(TmpTxt.Start + TmpTxt.Length, ShpTxt.Length) Set TmpTxt = ShpTxt.Replace( _ FindWhat:=FindWord, _ Replacewhat:=ReplaceWord, _ WholeWords:=True) Loop End If End If End If Next shp Next sld MsgBox "Done" End Sub |
#4
|
|||
|
|||
I'm stumped. Doing this manually, but there are 1105 slides, and I don't think I'm catching all of them. Anyone had a chance to look at this?
Regards, leaning |
#5
|
|||
|
|||
Your code depends on all the text being red and bold which may not be true but also Replace > Whole words setting will cause problems because of the way spaces are treated (not as words)
This code does not use replace and should unbold spaces and set to black (you can easily change the black to whatever) It may take a little while but a lot faster than manually!! Make sure you test on a copy Code:
Sub killRed() Dim otr As TextRange Dim oshp As Shape Dim L As Long Dim C As Long Dim osld As Slide For Each osld In ActivePresentation.Slides For Each oshp In osld.Shapes If oshp.HasTextFrame Then If oshp.TextFrame.HasText Then For L = oshp.TextFrame.TextRange.Paragraphs.Count To 1 Step -1 Set otr = oshp.TextFrame.TextRange.Paragraphs(L) For C = otr.Characters.Count To 1 Step -1 If Asc(otr.Characters(C)) = 32 Or Asc(otr.Characters(C)) = 13 Then If otr.Characters(C).Font.Color = vbRed And otr.Characters(C).Font.Bold = True Then 'otr.Characters(C) = "@" optional 'delete this to change to @ ''''''''''''''''''' otr.Characters(C).Font.Bold = False otr.Characters(C).Font.Color = vbBlack '''''''''''''''''''' End If End If Next C Next L End If End If Next oshp Next osld End Sub |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
how to highlight all "indexed" sentences using find and replace? | smallxyz | Word | 2 | 02-06-2016 02:54 AM |
space bar "deletes" as it "spaces" | S.R.C. | Word | 2 | 04-19-2015 05:56 AM |
remove repeated words with " macro " or " wild cards " in texts with parentheses and commas | jocke321 | Word VBA | 2 | 12-10-2014 11:27 AM |
Wierd symbols inplace of "space", "indentation" etc | aka.bhagvanji | Word | 5 | 02-16-2012 11:50 AM |
The heading doesn't "obey" the "before" space! why? | Jamal NUMAN | Word | 1 | 07-06-2011 04:25 AM |