At times it is a nuisance that built-in styles (like Normal or heading 1) can’t be renamed in Word.
Say you want to copy parts of one document into another with different style definitions, but want to keep the formatting. This is nearly impossible if both documents use built-in styles, because you can not rename the styles in one of the documents. So a paragraph formatted in Normal style will acquire the formatting of Normal in the document you paste into, and there is not much you can do about it (short of using “paste special” as a Word document object).
Another case where I found this a nuisance is when I take Word documents into a DTP program. Say the chapter headings in the DTP program are supposed to have style H1. Then I have to rename heading 1 in the DTP program, which often has to be done manually.
A macro solution in Word would be preferable.
The following macro renames all styles in the document by appending a * to the style name (heading 1 is changed to heading 1* …).
Since heading 1* isn’t recognized as a built-in style anymore, I can then rename it to anything I want (for example to H1).
The macro works by saving the file in RTF format, and changing all style names in the header of the RTF file.
Hope somebody else will find this useful, too.
The usual disclaimer: Use the macro at your own risk 
Klaus
Sub ChangeStyleNames()
' The macro appends a * to all style names
' It thus changes built-in styles to ordinary styles
Dim myRange As Range
Dim MsgText
Dim myFileName
MsgText = "Cancel if you have not saved the file"
If MsgBox(MsgText, vbExclamation + vbOKCancel, "Danger") = vbCancel Then
End
End If
myFileName = ActiveDocument.Name
If InStr(1, myFileName, ".") > 0 Then
myFileName = Left$(myFileName, InStr(1, myFileName, ".")) & "RTF"
Else
myFileName = myFileName & ".RTF"
End If
ActiveDocument.SaveAs _
FileName:=myFileName, _
FileFormat:=wdFormatRTF
ActiveDocument.Close
Documents.Open _
FileName:=myFileName, _
ConfirmConversions:=False, _
Format:=wdOpenFormatText
Set myRange = ActiveDocument.Content
myRange.Find.Execute _
FindText:="{stylesheet*}}", _
MatchWildcards:=True
myRange.Find.Execute _
FindText:=";}", _
ReplaceWith:="*^&", _
MatchWildcards:=True, _
Replace:=wdReplaceAll
ActiveDocument.Save
ActiveDocument.Close
Documents.Open _
FileName:=myFileName
End Sub
