I am trying to remove all the whitespace before and after all table objects in my word document.
This is the code I have so far:
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^p^p"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
This seems to delete some new line breaks but not all of them. After I have run this macro, when I click to Show all hidden characters it still shows some of the |P tags.
Try change
.Text = "^p^p"
to
.Text = Chr(32)
To find out which characters to replace, select your text and run the following macro.
Sub DebugAscCode()
For i = 1 To Len(Selection.Text)
Debug.Print Asc(Mid(Selection.Text, i))
Next i
End Sub
Using replace on VBA
Sub ReplaceAscCode()
Dim tmpArray As Variant
tmpArray = Array(7, 13, 32)
For j = LBound(tmpArray) To UBound(tmpArray)
Selection.Text = Replace(Selection.Text, ASC(tmpArray(j)), "")
Next j
End Sub
I've used in my work and it works perfectly this way, each character will always be represented by an ASC code
[]'s
Related
I want change a word to superscript in macro.
word 2016.
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "7th of every month."
.Replacement.Text = "7^th of every month."
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchAllWordForms = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
when i run the macro instead of making "th" as supercript it just create space between "7" and "h"
Result is like this "The meeting is on 7 h of every month."enter image description here
The following code searches for one or two digits, immediately followed by th and superscripts the th. This makes it more flexible than searching the specific string.
It works with a Range rather than a Selection object which will make it faster. The search type is a "wildcard" search.
Sub SuperScript_th_()
Dim rngFind As Word.Range
Dim searchText As String
Dim found As Boolean
Set rngFind = ActiveDocument.content
searchText = "[0-9]{1;2}th"
'searchText = "7th"
With rngFind.Find
.Text = searchText
.MatchWildcards = True
.wrap = wdFindStop
found = .Execute
Do While found
rngFind.Collapse wdCollapseEnd
rngFind.MoveStart wdCharacter, -2
rngFind.Font.Superscript = True
rngFind.End = ActiveDocument.content.End
found = .Execute
Loop
End With
End Sub
The ^t is the instruction in Word's Find to insert a TAB (like pressing the Tab-key on the keyboard). That's why the code in the quesiton is inserting space between the 7 the h in the Replacement.Text.
While Word's Find/Replace is able to format text as part of the Replacement, the difficulty here is that
Not all the text being found should be formatted
The entire text needs to be retained
It's not possible to tell Find/Replace to find text, then format only part of it. That's why the Find needs to be separate from the formatting action. If the entire found text needed to be formatted, then Find/Replace alone would work.
There are also no commands in Word's Find/Replace to apply formatting as a "code" in the Replacement.Text string.
Why don't simply try like this
With Selection.Find
.Text = "7th of every month."
'.Replacement.Text = "7^th of every month."
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchAllWordForms = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
Do While .Execute
ActiveDocument.Range(Selection.Range.Start + 1, Selection.Range.Start + 3).Font.Superscript = True
Loop
End With
Edit: With turning off some word options etc the 8 sec time to process 60 pages and 1240 replacement may be reduced to around 2 seconds. the test code
Sub test2()
Dim Rng As Range, tm As Double
tm = Timer
TurnOnOff False
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "7th of every month."
X = 0
Do While .Execute
ActiveDocument.Range(Selection.Range.Start + 1, Selection.Range.Start + 3).Font.Superscript = True
X = X + 1
Loop
End With
Debug.Print X, Timer - tm
TurnOnOff True
End Sub
Sub TurnOnOff(OnOff As Boolean)
Application.ScreenUpdating = OnOff
With Options
.Pagination = OnOff
.CheckSpellingAsYouType = OnOff
.CheckGrammarAsYouType = OnOff
End With
End Sub
I am trying to create VBA to insert before and after Supercript and subscript. My code is below.
Public Sub MySubscriptSuperscript()
Dim myRange As Word.Range, myChr
For Each myRange In ActiveDocument.StoryRanges
Do
For Each myChr In myRange.Characters
If myChr.Font.Superscript = True Then
myChr.Font.Superscript = False
myChr.InsertBefore "<sup>"
myChr.InsertAfter "</sup>"
End If
If myChr.Font.Subscript = True Then
myChr.Font.Subscript = False
myChr.InsertBefore "<sub>"
myChr.InsertAfter "</sub>"
End If
Next
Set myRange = myRange.NextStoryRange
Loop Until myRange Is Nothing
Next
End Sub
This code is working good for each character of superscript and subscript.
But, I am looking for VBA which insert tags before and after complete superscript/subscript word/letters.
Example
C12H22O11 and x23 + y397 + x67
Above VBA is giving following Output
C<sub>1</sub><sub>2</sub>H<sub>2</sub><sub>2</sub>O<sub>1</sub><sub>1</sub><sub> </sub><sub> </sub> and x<sup>2</sup><sup>3</sup> + y<sup>3</sup><sup>9</sup><sup>7</sup> + x<sup>6</sup><sup>7</sup>
But I am looking for this output
C<sub>12</sub>H<sub>22</sub>O<sub>11</sub> and x<sup>23</sup> + y<sup>397</sup> + x<sup>67</sup>
Pls guide, how this can be achieved.
I would be tempted to go for easiest way to get the end result - at the end, simply do a replace of </sub><sub> and </sup><sup> with an empty string "".
But then, I am lazy this way...
Edit - just an idea:
wouldn't it be faster to do the whole thing with replace? You wouldn't have to check every character. Here is what Word does record for the replacement, it would need a bit of polishing:
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Superscript = False
.Subscript = False
End With
With Selection.Find
.Text = "^?"
.Replacement.Text = "<sup>^&</sup>"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
So, at the end, you would run search&replace 4 times:
replace superscript
delete the closing and opening tags for superscript
replace subscript
delete the closing and opening tags for subscript
Try:
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Text = ""
.Wrap = wdFindContinue
.Font.Subscript = True
.Replacement.Text = "<sub>^&<\sub>"
.Execute Replace:=wdReplaceAll
.Font.Superscript = True
.Replacement.Text = "<sup>^&<\sup>"
.Execute Replace:=wdReplaceAll
End With
End With
Application.ScreenUpdating = True
End Sub
It's not apparent why you'd be looping through all storyranges, as such content would ordinarily only be in the document body. That said, it's easy enough to modify the code to work with all storyranges.
I am using the following code to bold parts of a text string, in this case where the word 'Fish' is in brackets after the word 'Oil':
Sub ReplaceAndFormat16()
Dim sConst1 As String, sReplaceMent As String
Dim rRange As Range, rFormat As Range
sConst1 = "Fish"
sReplaceMent = "Oil (" & sConst1 & ")"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Oil (Fish)"
.Replacement.Text = sReplaceMent
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceOne
If .Found Then
Set rRange = Selection.Range
Set rFormat = ActiveDocument.Range(rRange.Start + 5, rRange.Start + 5 + VBA.Len(sConst1))
rFormat.Font.Bold = True
End If
End With
End Sub
This code works perfectly, but only bolds the first instance, and my documents may have up to four instances of this phrase that need to be formatted bold.
How do I amend the code so it carries on and bolds all instances in the document? I am very new to VBA, so apologies if this seems like a stupid question.
Change the line
.Execute Replace:=wdReplaceOne
to
.execute Replace:=wdReplaceAll
Edit
OK the above was a stupid response. The code below does the right thing
Sub ReplaceAndFormat16()
Const myFindStr As String = "Oil (Fish)"
Dim myFindRange As Word.Range
Set myFindRange = ActiveDocument.StoryRanges(wdMainTextStory)
Do
With myFindRange.Find
.ClearFormatting
.Text = myFindStr
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
If .Found Then
With myFindRange
.MoveStartUntil cset:="fF"
.MoveEndUntil cset:="hH", Count:=wdBackward
.Font.Bold = True
.Collapse Direction:=wdCollapseEnd
End With
Else
Exit Sub
End If
End With
Loop
End Sub
I am trying to find all dashes that are alone in table cells and center them. What i have built below thus far will center all dashes in the document. How can I encapsulate this to center only the dashes in cells by themselves?
Sub Macro9()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.Alignment = wdAlignParagraphCenter
End With
With Selection.Find
.Text = "-"
.Replacement.Text = "-"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Since you want to restrict your searches to only a single dash in a single cell, you're better off only checking cell contents. Otherwise if you use .Find in the range of a table, you'll have to check all sorts of special cases to make sure the "found" dash is all alone in the cell. I think this works pretty efficiently:
Option Explicit
Sub Macro9()
Dim tbl As Table
Dim tCell As Cell
Dim r, c As Integer
Dim cellContents As String
For Each tbl In ActiveDocument.Tables
For r = 1 To tbl.Rows.Count
For c = 1 To tbl.Columns.Count
Set tCell = tbl.Cell(r, c)
'--- trim the cell delimiter off the end, then whitespace
cellContents = Left(tCell.Range.Text, Len(tCell.Range.Text) - 2)
cellContents = Trim(cellContents)
If cellContents = "-" Then
tCell.Select
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
End If
Next c
Next r
Next tbl
End Sub
#PeterT what are you thoughts on this? (a collegue and I pulled it together)
Sub Macro1()
Dim CurrentText As Range
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "-"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Do While Selection.Find.Execute
If Selection.Information(wdWithInTable) Then
Set CurrentText = Selection.Cells(1).Range
CurrentText.End = CurrentText.End - 1
If (CurrentText.Text = "-") And Not (Selection.Information(wdAlignParagraphCenter)) Then
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
End If
End If
Loop
End Sub
I'm trying to create a macro in word to find particular cells in a table and replace certain strings there. For example:
(word1 or word2 or word3).ab,ti.
Should be replaced by
word1[TIAB] or word2[TIAB] or word3[TIAB]
So, what I've done so far is a simple replaceAll to delete the initial brackets and replace the suffix ").ab,ti." by "[TIAB]. But that doesn't append the endings to word1 and word2, of course.
Sub Makro6()
'
' Makro6 Makro
'
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".ab,ti."
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
I guess what I need is to embed a loop in the replaceAll sub, which runs from the first position to the end of the current row and replaces the string " or " by "[TIAB] or ". However, I'm completely new to VBA so I somehow can't figure out how to do this. Any suggestions?
Thanks for your help!
Leni
This code performs the actions you want:
Sub Makro6()
Dim maxCount, curCount As Integer
maxCount = 3
curCount = 0
Do
curCount = curCount + 1
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = Chr(40) & "word" & curCount & Chr(41) & ".ab,ti."
.Replacement.Text = "word" & curCount & "[TIAB]"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.Execute Replace:=wdReplaceAll
End With
Loop While (curCount < maxCount)
End Sub
Note that I had to rely on ASCII codes (Chr(40) & Chr(41)) to account for the parenthesis because surprisingly (at least, for me), the macro wasn't able to find the target string. I did some tests and the problem only happens with parenthesis followed by another character (?!).