Sub markup_italics()
  With ActiveDocument.Range(0, 0).Find
    .Text = ""
    .Font.Italic = True
    .Replacement.Text = "<i>^&</i>"
    .Execute Replace:=wdReplaceAll
  End With
End Sub

Sub restore_italics()
  With ActiveDocument.Range(0, 0).Find
    .Text = "\<i\>(*)\</i\>"
    .Replacement.Text = "\1"
    .Replacement.Font.Italic = True
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
  End With
End Sub