Copy previous heading number of "Heading " to the paragraph in "Normal "style

[kamkwok6]

29485

Hi everyone, I really need a help on that.

The first picture is the original source file with all the numbering and style formatting.

2948429485

Ultimately, I would like to copy all the heading number to corresponding paragraph as below.


29483

I did some research and found some related code. And finally successfully adding some pre-set text at the beginning of the paraph with "Normal" Style, however , the second paragraph of that section would not be able to add. I don't know why. which show as below

29482

After that I find another code which show the corresponding level of that para with msg box.

29486

Can you someone can help to merge these function together...




Sub ApplyMultiLevelHeadingNumbers()
Selection.Range.ListFormat.ConvertNumbersToText
End Sub


Sub Demo()
Application.ScreenUpdating = False
Dim Par As Paragraph, Rng As Range
For Each Par In ActiveDocument.Paragraphs
If Par.Style = "Normal" Then
If Rng Is Nothing Then
Set Rng = Par.Range
Else
Rng.End = Par.Range.End
End If
Else
Call RngFmt(Rng)
End If
If Par.Range.End = ActiveDocument.Range.End Then
Call RngFmt(Rng)
End If
Next
Application.ScreenUpdating = True
End Sub


Sub RngFmt(Rng As Range)
If Not Rng Is Nothing Then
With Rng
.End = .End - 1
.InsertBefore "(Sample) "
Set Rng = Nothing
End With


End If
End Sub




Public Sub FindPreviousOutlineLevel()
Dim aNumber As Long
Dim aRange As Word.Range


Set aRange = ActiveDocument.Range(0, Selection.Range.End)
For aNumber = aRange.Paragraphs.Count To 1 Step -1
If ActiveDocument.Paragraphs(aNumber).Range.ParagraphFormat.OutlineLevel _
<> 10 Then
Set aRange = ActiveDocument.Paragraphs(aNumber).Range
With aRange.Find
.MatchWildcards = True
.Text = "<[0-9.-]{1,}"
.Execute
If .Found Then
MsgBox aRange


Else
MsgBox "No Number Found Here: " & aRange
End If
End With
Exit For
End If
Next aNumber
End Sub

[gmayor]

If I understand correctly, the following will do what you require, at least with your sample document.
If you want the strings added before any existing text between the heading sections then remove the two optional lines.

Sub Macro1()
Dim oPara As Paragraph
Dim oRng As Range
Dim lPara As Long
Dim sHead As String
Const sList As String = "0123456789.)"
For lPara = ActiveDocument.Paragraphs.Count To 1 Step -1
Set oPara = ActiveDocument.Paragraphs(lPara)
If oPara.Style Like "Heading ?" Then
If Not Right(oPara.Style, 1) = sHead Then
sHead = Right(oPara.Style, 1)
If lPara = ActiveDocument.Paragraphs.Count Then 'optional
oPara.Range.InsertParagraphAfter
End If 'optional
Set oRng = oPara.Range.Next.Paragraphs(1).Range
oRng.Text = oPara.Range.Text
oRng.Style = "Normal"
oRng.Collapse 1
oRng.InsertBefore "("
oRng.MoveEndWhile sList
oRng.InsertAfter ")"
End If
End If
Next lPara
lbl_Exit:
Set oPara = Nothing
Set oRng = Nothing
Exit Sub
End Sub

[kamkwok6]

Thank you for your reply The direction is right, however the outcome is not what exactly I want .<br>
When I used your code above, it directly replace the content with the heading. <br>
What I looking for is that the content remind unchanged, and only adding the numbering of heading at the begining of the corresponding paragraph.<br>
(Like what I highlight in the final output below) 29488

[gmayor]

Ah! OK that needs a slightly different approach. I have included the highlight, to demonstrate it works, but that is easily removed, by removing the indicated line.

Sub Macro1()
Dim oPara As Paragraph
Dim oRng As Range
Dim lPara As Long
Dim sHead As String

For lPara = 1 To ActiveDocument.Paragraphs.Count
Set oPara = ActiveDocument.Paragraphs(lPara)
If oPara.Style Like "Heading ?" Then
sHead = Split(oPara.Range.Text, Chr(9))(0)
sHead = "(" & sHead & ") "
ElseIf oPara.Style = "Normal" Then
Set oRng = oPara.Range
If Len(oRng) > 1 Then
oRng.Collapse 1
oRng.Text = sHead
oRng.HighlightColorIndex = wdYellow 'to illustrate
End If
End If
Next lPara
lbl_Exit:
Set oPara = Nothing
Set oRng = Nothing
Exit Sub
End Sub

[kamkwok6]

It does work!! Thank you so much !! Ask one more question here.

What if , I want this function apply to my selection only but not the whole document.?

[gmayor]

Change the two instances of 'ActiveDocument' to 'Selection'