View Single Post
 
Old 04-16-2018, 03:00 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,467
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Your addition of:
(?@>)
to the first macro is unlikely to help; indeed it will produce masses of extra tags. If you're getting spurious tags somewhere, that's because you have spurious formatting in those locations.

It's also not the code I posted that is creating any capitalised tags. The only way I can envisage that happening is if you have existing content formatted with a Style using the 'All Caps' or 'Small Caps' attribute. As for adding:
.MatchCase = False
to the second macro, that won't work because it's doing a wildcard Find. Try:
Code:
Sub aabFettKursivQuelldok()
Application.ScreenUpdating = False
With ActiveDocument
  .AutoHyphenation = False
  With .Range
    .ListFormat.ConvertNumbersToText
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Format = True
      .Forward = True
      .MatchWildcards = True
      .Wrap = wdFindContinue
      .Font.Underline = True
      .Text = ""
      .Replacement.Text = "<u>^&</u>"
      .Execute Replace:=wdReplaceAll
      .ClearFormatting
      .Highlight = True
      .Replacement.Text = "<h>^&</h>"
      .Execute Replace:=wdReplaceAll
      .ClearFormatting
      .Font.Bold = True
      .Replacement.Text = "<b>^&</b>"
      .Execute Replace:=wdReplaceAll
      .ClearFormatting
      .Font.Italic = True
      .Replacement.Text = "<i>^&</i>"
      .Execute Replace:=wdReplaceAll
    End With
    .Style = wdStyleNormal
    .Font.Reset
    .HighlightColorIndex = wdNoHighlight
  End With
End With
Application.ScreenUpdating = True
End Sub
Code:
Sub aabFettKursivZieldok()
Application.ScreenUpdating = False
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Format = True
  .Forward = True
  .MatchWildcards = True
  .Wrap = wdFindContinue
  .Replacement.Text = "\1"
  .Text = "\<[Uu]\>(*)\</[Uu]\>"
  .Replacement.Font.Underline = True
  .Execute Replace:=wdReplaceAll
  .Replacement.ClearFormatting
  .Text = "\<[Hh]\>(*)\</[Hh]\>"
  .Replacement.Highlight = True
  .Execute Replace:=wdReplaceAll
  .Replacement.ClearFormatting
  .Text = "\<[Bb]\>(*)\</[Bb]\>"
  .Replacement.Font.Bold = True
  .Execute Replace:=wdReplaceAll
  .Replacement.ClearFormatting
  .Text = "\<[Ii]\>(*)\</[Ii]\>"
  .Replacement.Font.Italic = True
  .Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote