Worldanvil text formatting Word.vba

' Title1 style => text size = +5
Sub bbcodeTitle1()

Dim i As Integer
Dim aRange As Range
For i = 1 To ActiveDocument.Paragraphs.Count
	If ActiveDocument.Paragraphs(i).style = ActiveDocument.Styles(wdStyleHeading1) Then
		ActiveDocument.Paragraphs(i).style = wdStyleNormal
		Set aRange = ActiveDocument.Range(Start:=ActiveDocument.Paragraphs(i).Range.Start, End:=ActiveDocument.Paragraphs(i).Range.End - 1)
		aRange.InsertBefore ("[center][size=" + Chr(34) + "5" + Chr(34) + "]")
		aRange.InsertAfter ("[/size][/center]")
	End If
Next i
End Sub



' Title2 style => text size = +3
Sub bbcodeTitle2()

Dim i As Integer
Dim aRange As Range
For i = 1 To ActiveDocument.Paragraphs.Count
	If ActiveDocument.Paragraphs(i).style = ActiveDocument.Styles(wdStyleHeading2) Then
		ActiveDocument.Paragraphs(i).style = wdStyleNormal
		Set aRange = ActiveDocument.Range(Start:=ActiveDocument.Paragraphs(i).Range.Start, End:=ActiveDocument.Paragraphs(i).Range.End - 1)
		aRange.InsertBefore ("[center][size=" + chr(34) + "3" + chr(34) + "]")
		aRange.InsertAfter ("[/size][/center]")
	End If
Next i

End Sub

Private Sub ConvertSize()
   
Dim fSize&
   
    If convertFontSize = False Then Exit Sub
   
    If DefaultFontSize = 12 Then DefaultFontSize = 12
    fSize = 12
       
    For fSize = 1 To 50
    If fSize > DefaultFontSize + 1 Or fSize < DefaultFontSize - 1 Then 'at least two points difference
        ActiveDocument.Select
        With Selection.Find
   
            .ClearFormatting
            .Font.Size = fSize
            .Text = ""
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Forward = True
            .Wrap = wdFindContinue
   
            Do While .Execute
                With Selection
   
                    If Len(.Text) > 1 And InStr(1, .Text, vbCr) Then
                        ' Just process the chunk before any newline characters
                        ' We'll pick-up the rest with the next search
                        .Collapse
                        .MoveEndUntil vbCr
                    End If
   
                    ' Don't bother to markup newline characters (prevents a loop, as well)
                    If Not .Text = vbCr Then
                        If fSize = DefaultFontSize Then
                            .InsertBefore "[size=" & fSize & "]"
                            .InsertAfter "[/size]"
                         End If
                    End If
   
                    If useDefaultStyle Then .Style = ActiveDocument.Styles(DefaultStyleName) 'must be localized to your language, see CONST on top
                    .Font.Size = DefaultFontSize
                    '.Collapse wdCollapseEnd
                    '.MoveLeft , 4, True
                    'ClearFormatting
   
                End With
            Loop
        End With
    End If
    Next

End Sub