I have a document containing tags, and now I would like to delete all the tags in headings only. Please refer to the example below. The tags also appear in the content as well, but I only need to delete the tags in Heading1, Heading2, Heading3.
e.g.
(before)
1 Hello world[A]
1.1 Hello Tokyo[A][B]
1.1.1 Hello NYC[C]
blablablabla[A][B]
(after)
1 Hello world
1.1 Hello Tokyo
1.1.1 Hello NYC
blablablabla[A][B]
The following is my code to work, but the result shows the tags in the content are deleted too. Take the above as example, [A]and[B] in blablablabla[A][B] are also deleted with my code. Please help me find out is there anything wrong in my code, thanks!
Sub mainsub()
DeleteBrackets wdStyleHeading1
DeleteBrackets wdStyleHeading2
DeleteBrackets wdStyleHeading3
'I have other code in my main sub, just show my way to call the functioin
End Sub
Public Sub DeleteBrackets(headingStyle As WdBuiltinStyle)
Application.ScreenUpdating = False
Selection.HomeKey Unit:=wdStory
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Style = headingStyle
.Text = "\[*\]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Change
.Format = False
to
.Format = True
Related
in a file MS WORD I wish to select a "/" and make bold all characters till the following ^p. The following code works well only for the first occurrence. In the file I have many occurrences and I am not able to apply this in the whole file. I tried several times with "for...next" and others, unfortuntely without success.
Many thanks for your help! Gianluca
Sub bold_title()
Set myRange = ActiveDocument.Content
Selection.Find.ClearFormatting
With Selection.Find
.Text = "/"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Extend
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^p"
.Forward = True
.Wrap = wdFindAsk
.Format = False
End With
Selection.Find.Execute
Selection.Font.Bold = True
End Sub
The trick is to "collapse" the Selection- think of it like pressing the right-arrow key - so that the next search starts after the "found" text:
Selection.Collapse wdCollapseEnd
Usually, a Do While...Loop construct is used in order to repeat the Find until the end of the document. You'll find lots and lots of examples if you search here and elsewhere on the Internet.
For this to work successfully, make sure you set Wrap to wdFindStop (and not wdFindContinue as is currently in the code shown).
i am attempting to write a macro that with find/replace a string and than move it to an existing heading. The original text is like this:
1. Heading 1
ID: abcd
1.1 Heading 2
ID: abcd
And it should look like:
1.Heading 1 abcd
1.1 Heading 2 abcd
I am having some problems with the code i tried to write, mostly because i am kinda new, but this is what i created so far:
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Style = "Heading 2"
With Selection.Find
.Text = "abcd"
.Replacement.Text = "abcd^p"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
The text is not so important because i managed to replace with what i want but i don't know how to align it with the Heading style.. Thanks
EDIT: I hope i don't screw up again, sorry big :). So i have raw which is the raw text and i want to process it to look like this final. I already found out, thanks to you how to replace the text, it's just that i stuck in the raw version. Thanks, I kinda own you a beer, or two
LATER EDIT: So i have 5 types of Heading formats, 1. Heading 1, 1.1 Heading 2 etc till 5, and all of them have below them an ID, each with a specific number, but the name is the same, ID ASD_PC_AWP_[XXXX]. I just have to get rid of ID ASD_PC_ and put AWP_[xxxx] at same level of the Heading eg: 1.Heading 1 AWP_[xxxx1] ** , **2. Heading 2 AWP_[xxx2]...
Try:
Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "ID:*^13"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
Set Rng = .Duplicate.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
Rng.End = Rng.Paragraphs.First.Range.End - 1
Rng.InsertAfter Split(Split(.Duplicate.Text, ":")(1), vbCr)(0)
.Text = vbNullString
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
End Sub
Do a wildcard find for any paragraph marker which is followed by ID:.
.Text = "^13ID:"
.Replacement.Text = ""
You will need to specify the style of the replacement text to the heading style because when you delete the paragraph marker at the end of the Heading paragraph you will also delete the style information for the heading paragraph.
You will need to do this with every style heading followed by the ID: text.
Updated 2018-11-01
The following code should work. I got some hints from Macropods ingeneous code.
Update 2 2018-11-01
Revised to work with a list of styles defined by user at OPs request
Sub ConsolidateHeadingWithID()
Const HEADINGS As String = "Heading 1,Heading 2,Heading 3,Heading 4,Heading 5,Other style,another style"
Dim my_headings As Variant
Dim my_heading As Variant
my_headings = Split(HEADINGS, ",")
For Each my_heading In my_headings
With ActiveDocument.StoryRanges(wdMainTextStory)
With .Find
.ClearFormatting
.format = True
.Text = ""
.Style = my_heading
.MatchWildcards = True
.Wrap = wdFindStop
.Execute
End With
Do While .Find.Found
If .Duplicate.Next(unit:=wdWord).Text = "ID" Then
.Duplicate.Next(unit:=wdParagraph).Style = my_heading
End If
.Collapse wdCollapseEnd
.MoveStart unit:=wdCharacter, Count:=2
.Find.Execute
Loop
End With
With ActiveDocument.Range.Find
.ClearFormatting
.format = True
.Text = "(^13)(ID:)(*)(AWP_)([0-9]{1,})"
.Style = my_heading
.Replacement.Text = " [\4\5]"
.MatchWildcards = True
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Next
End Sub
I have a lot of links in the document and am trying to write a code to replace all ActiveDocument.Path with a certain word. However, the following code does not seem to recognize ActiveDocument.Path as an input. Any suggestion would be appreciated.
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ActiveDocument.Path
.Replacement.Text = "xxx"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
Selection.Find.Execute Replace:=wdReplaceAl
End Sub
Try to insert the activedocument.path to your document and then check manually what is wrong with the actual text.
run this to see the actual path and then if it is showing OK, rest is easy.
Sub test()
ActiveDocument.Range.Collapse wdCollapseStart
ActiveDocument.Range.InsertBefore ActiveDocument.Path
End Sub
I am looking to create a macro that allows me to delete a specific amount of text until it finds an open paragraph. For example:
gateways (...)
ABC
DEF
GHJ
IKL
Other
I want to delete by searching the word "gateways" and then delete all text until it finds the line before "Other". The problem is that the amount of text until "other" is variable from document to document, and I cannot find a macro that allows me to do that wothout errors.
To delete the text Gateway down to the empty line, leaving only Other
Public Sub DeleteFromTextToEmptyLine()
Selection.Find.ClearFormatting
With Selection.Find
.Text = "gateways"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
'find text
If Selection.Find.Execute() Then
'Selection.Collapse wdCollapseEnd 'remove comment to leave the word gateway intact
'Turn on Extended select mode
Selection.ExtendMode = True
'find two paragraph marks together, i.e. empty line
With Selection.Find
.Text = "^p^p"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
'if found, delete the selection
If Selection.Find.Execute() Then Selection.Delete
End If
End Sub
If you want to leave the word gateway, remove the comment from the indicated line
in my word file there are hundrens of paragraph which like the format below. There is a single letter Y here. It can be other letter except "A","T","C","G". I want to remove the white space in it then create a new line.
AAATGGGCCC CACAGAAGTG AGAATGGGTG AAGTCAGAAT TCCTGGTAAT GAAGTGCTTG
AACTTGGATT CCTCCCGACA TGTGCAGTAC AATGAGATGA TTTTCTCCTT AATGAGATTA
GGAAATTCTA TTAGCGCTCC CAGCTGCTGA CCCGATTCCA TGAGGCTGAG GCTCCAGGGC
TGAACCTGCC TGGTT
Y
AGTGTTCCTG GAAACTAGAC ACCCCACCCT TCAGATGGGC CAGGGCCTCC CCAGCTCTAC
CTAAAGCTGT GGTCTGCCCC CAGGGGTGCC CAGTTTCCTC CCTTCACCCT GTGCTCCAGA
GGAGTGTGGG GCCCTGGGCA TTCTGCAGTG TACCCCAGGA TCCTCACTCC TTCCTGCTTA
The new line's format is
AAATGGGCCCCACAGAAGTGAGAATGGGTGAAGTCAGAATTCCTGGTAATGAAGTGCTTGAACTTGGATTCCTCCCGACATGTGCAGTACAATGAGATGATTTTCTCCTTAATGAGATTAGGAAATTCTATTAGCGCTCCCAGCTGCTGACCCGATTCCATGAGGCTGAGGCTCCAGGGCTGAACCTGCCTGGTT[Y]AGTGTTCCTGGAAACTAGACACCCCACCCTTCAGATGGGCCAGGGCCTCCCCAGCTCTACCTAAAGCTGTGGTCTGCCCCCAGGGGTGCCCAGTTTCCTCCCTTCACCCTGTGCTCCAGAGGAGTGTGGGGCCCTGGGCATTCTGCAGTGTACCCCAGGATCCTCACTCCTTCCTGCTTA
Notice Y becomes [Y].
The final result will be saved as a text file. Thanks for help.
You don't need to write a program. The “Replace” tool is sufficient for this:
Replace Y with [Y] (EDIT: see the comments below, because it's a little more complex than that indeed)
Replace ^w with nothing (^w means whitespace)
Replace ^p with nothing (^p means paragraph markers)
EDIT: if you need a macro, just do the above once while recording a macro.
EDIT: by applying the method discussed in the comments, I get the following VBA macro:
Sub ProcessATCG()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "([!ACGT^13^32])"
.Replacement.Text = "[\1]"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "[^13^32]"
.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