#1
|
|||
|
|||
need to retain formatting
Code:
Sub HeadsTransformReverse() Dim para As Paragraph Dim i As Integer For i = ActiveDocument.Paragraphs.Count - 1 To 1 Step -1 Dim currentParaText As String Dim nextParaText As String currentParaText = ActiveDocument.Paragraphs(i).Range.text nextParaText = ActiveDocument.Paragraphs(i + 1).Range.text If Left(nextParaText, 4) = "<S5>" And Left(currentParaText, 4) = "<S4>" Then ActiveDocument.Paragraphs(i + 1).Range.text = "<S4-S5>" & Mid(nextParaText, 5) HighlightTags ActiveDocument.Paragraphs(i + 1).Range ElseIf Left(nextParaText, 4) = "<S4>" And Left(currentParaText, 4) = "<S3>" Then ActiveDocument.Paragraphs(i + 1).Range.text = "<S3-S4>" & Mid(nextParaText, 5) HighlightTags ActiveDocument.Paragraphs(i + 1).Range ElseIf Left(nextParaText, 4) = "<S3>" And Left(currentParaText, 4) = "<S2>" Then ActiveDocument.Paragraphs(i + 1).Range.text = "<S2-S3>" & Mid(nextParaText, 5) HighlightTags ActiveDocument.Paragraphs(i + 1).Range ElseIf Left(nextParaText, 4) = "<S2>" And Left(currentParaText, 4) = "<S1>" Then ActiveDocument.Paragraphs(i + 1).Range.text = "<S1-S2>" & Mid(nextParaText, 5) HighlightTags ActiveDocument.Paragraphs(i + 1).Range End If Next i End Sub Sub HighlightTags(rng As Range) Dim startPos As Long Dim endPos As Long Dim tagText As String startPos = InStr(rng.text, "<") While startPos > 0 endPos = InStr(startPos, rng.text, ">") If endPos > 0 Then tagText = Mid(rng.text, startPos + 1, endPos - startPos - 1) rng.Start = rng.Start + startPos - 1 rng.End = rng.Start + Len(tagText) + 2 rng.HighlightColorIndex = wdTurquoise rng.Start = rng.Start + Len(tagText) + 2 End If startPos = InStr(startPos + 1, rng.text, "<") Wend End Sub |
#2
|
||||
|
||||
Does this do what you wanted?
Code:
Sub HeadsTransformReverse() Dim i As Integer For i = ActiveDocument.Paragraphs.Count To 2 Step -1 TagRange ActiveDocument.Paragraphs(i - 1).Range, ActiveDocument.Paragraphs(i).Range Next i End Sub Function TagRange(rng1 As Range, rng2 As Range) Dim i1 As Integer, i2 As Integer, rngTag As Range If rng1.Text Like "<S#>*" And rng2.Text Like "<S#>*" Then i1 = CInt(Mid(rng1.Text, 3, 1)) i2 = CInt(Mid(rng2.Text, 3, 1)) If i2 = i1 + 1 Then Set rngTag = rng2.Duplicate rngTag.End = rngTag.Start + 4 rngTag.Text = "<S" & i1 & "-" & i2 & ">" rngTag.HighlightColorIndex = wdTurquoise End If End If End Function
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#3
|
|||
|
|||
Thanks. Like this only.
|
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Retain Text Formatting across Views? | Buzzdarkmonth | Project | 2 | 06-20-2023 04:27 AM |
Accept/reject tracked changes in word and retain font color/formatting | 1van | Word VBA | 3 | 07-08-2020 06:02 AM |
How to Retain Existing Transitions? | wvought | PowerPoint | 2 | 03-27-2014 06:13 AM |
WDFormatOriginalFormatting does not retain formatting when content pasted from RTF | ramsgarla | Word Tables | 1 | 10-05-2012 02:35 AM |
How to retain italics when pasting from PDF? | WaltR | Word | 0 | 03-01-2011 04:01 PM |