einige Zeichen verlieren Formatierung in VBA Makro andere nicht

Question

Ich habe eine Reihe von Dokumenten, die in der Prä-Unicode-Ära gemacht werden, und enthalten Transkriptionen verschiedener Sprachen, jeweils mit ihren eigenen Schriftarten. Ich habe ein Makro erstellt, das jedes Zeichen in einem Dokument durch ein anderes Zeichen (von mehreren alten Transkriptionsschriftarten in eine Unicode-Schriftart) ersetzt. (siehe unten stehenden Code des Makros für eine dieser Schriftarten)

Aus irgendeinem Grund behält das Makro die Formatierung (in meinem Fall meist kursiv) für einige Zeichen, nicht für andere. Dies hinterlässt viele Wörter, in denen einige Buchstaben kursiv sind und andere Buchstaben nicht, z.

al-Malik al-Mu ǧā versteckte hú T ba

Die Zeichen, die die Formatierung sind alle Zeichen mit diakritischen Zeichen zu verlieren, aber nicht alle Zeichen mit diakritischen Zeichen verlieren ihre Formatierung (zB die ḫ im Beispiel). Nicht alle Zeichen, die ihre Formatierung beibehalten, haben den gleichen Codepunkt in der ursprünglichen Schriftart wie in der Unicode-Schriftart (z. B. hat das ḫ im Beispiel die Unicode-Nummer U + 23 in der ursprünglichen Schriftart und U + 1E2B in der Unicode-Schriftart).

Haben Sie eine Idee, warum die Formatierung für einige Zeichen beibehalten wird und nicht für andere? Oder wie ich dieses Problem lösen könnte?

Alternativ ich ein anderes Makro dem Verfahren könnte hinzufügen, dass alle Wörter formatieren würde, die mindestens einen Buchstaben kursiv in Kursivschrift enthalten (aber, wie das zu tun, ist eine andere Frage: MS Word macro to correct partially formatted words).

Sub BatchReplaceAOTimes() 

'Replace the font AO Times New Roman in the body and footnotes 
'of the active document 

Debug.Print "Replacing AO Times New Roman font" 
Dim old_values(270) As String 
Dim unicode_values(270) As Long 

old_values(0) = &H30 
old_values(1) = &H31 
(...) 
old_values(263) = &HFD 
old_values(264) = &HDD 
old_values(265) = &H178 
old_values(266) = &HFF 
old_values(267) = &H5A 
old_values(268) = &H7A 
old_values(269) = &H2C 
old_values(270) = &H9 

unicode_values(0) = &H30 
unicode_values(1) = &H31 
(...) 
unicode_values(263) = &H2BE 
unicode_values(264) = &H2BF 
unicode_values(265) = &H1E6E 
unicode_values(267) = &H5A 
unicode_values(268) = &H7A 
unicode_values(269) = &H2C 
unicode_values(270) = &H9 

Selection.HomeKey Unit:=wdStory 

Dim ThisRng As Range 

'do body text 
Set ThisRng = ActiveDocument.StoryRanges(wdMainTextStory) 
For i = 0 To 270 
    Debug.Print i 

    ThisRng.Find.ClearFormatting 
    ThisRng.Find.Replacement.ClearFormatting 

    With ThisRng.Find 
     .Font.Name = "AO Times New Roman" 
     .Text = ChrW(old_values(i)) 
     .Replacement.Font.Name = "Arial Unicode MS" 
     .Replacement.Text = ChrW(unicode_values(i)) 
     .Forward = True 
     .Wrap = wdFindContinue 
     .Format = True 
     .MatchCase = True 
     .MatchWholeWord = False 
     .MatchKashida = False 
     .MatchDiacritics = False 
     .MatchAlefHamza = False 
     .MatchControl = False 
     .MatchWildcards = False 
     .MatchSoundsLike = False 
     .MatchAllWordForms = False 
    End With 
    ThisRng.Find.Execute Replace:=wdReplaceAll 
    Next i 

    (...: do the same for the footnotes) 

    End Sub 

Answer 1

können Sie versuchen, Autokorrektur Drehen wie aus einige Zeichen ersetzen kann.

In Word Zeichen Paragraph Stil und Charakter Stil, so dass Sie in solche, versuchen suchen:

Debug.Print ThisRng.Style.Description 
Debug.Print ThisRng.CharacterStyle.Description 
Debug.Print ThisRng.ParagraphStyle.Description 

Answer 2

Zunächst nur als Anregung, könnten Sie eine kleinere Codebasis haben, wenn Sie das Array gesetzt, wie: -

Dim ValueMap(270) As String 
Dim AryTemp()  As String 
ValueMap(0) = "&H30|&H30" 

For i = 0 To 270 
    AryTemp = Split(ValueMap(i),"|") 
    'AryTemp(0) = The Old 
    'AryTemp(1) = The New 
Next 

Zu einer Antwort auf Ihre Frage. Mir ist nicht bewusst, wie ich verhindern kann, dass die Kursivschrift verloren geht. Ich vermute, dass dies dadurch verursacht werden könnte, dass sie über einen Stil statt Formatierung kursiv gesetzt wurde oder umgekehrt, aber diese Untersuchungstiefe würde nicht in diese Umgebung passen (Q & A) Ich denke nicht.

Für eine Lösung gibt es viele Möglichkeiten zu tun, was Sie brauchen, wie in Ihrem other question gelöst, ich glaube nicht, dass dies in einer umfassenden Art und Weise getan werden kann (dh es gibt keine Möglichkeit, all das zu setzen kursiv kursiv kursiv), da die Information nach dem Suchen und Ersetzen nicht beibehalten wird. Es müsste also an dem Punkt gemacht werden, an dem das Zeichen getauscht wird, was bedeutet, dass es nur einen zu einem Zeitpunkt finden und ersetzen kann, der sich auf die Leistung auswirkt.

Im folgenden Beispiel habe ich auch die oben beschriebene Methode der kürzeren Anordnung verwendet.

Public Sub Sample() 
Dim BlnWasItalic  As Boolean 
Dim AryValueMap(270) As String 
Dim AryTemp()   As String 
Dim LngLocation   As Long 
Dim LngValueID   As Long 
Dim WdDoc    As Word.Document 
Dim WdFnd    As Word.Find 
Dim WdRng    As Word.Range 
Dim WdSlct    As Word.Selection 

AryValueMap(0) = "&H30|&H30" 
AryValueMap(1) = "&H31|&H31" 
'... 
AryValueMap(269) = "&H2C|H2C" 
AryValueMap(270) = "&H9|&H9" 

Set WdDoc = ThisDocument 
    For Each WdRng In WdDoc.StoryRanges 
     For LngValueID = 0 To 270 
      WdRng.Select 
      Set WdSlct = Selection 
       WdSlct.SetRange 0, 0 
       Set WdFnd = WdSlct.Find 

        'Clear any previous find settings 
        If LngValueID = 0 Then 
         WdFnd.ClearAllFuzzyOptions 
         WdFnd.ClearFormatting 
         WdFnd.ClearHitHighlight 

         .Font.Name = "AO Times New Roman" 

        End If 

        AryTemp = Split(AryValueMap(LngValueID), "|") 

        'Look for any italic character 
        Do Until Not WdFnd.Execute(FindText:=ChrW(AryTemp(0)), MatchCase:=True, _ 
               MatchWholeWord:=False, MatchWildcards:=False, _ 
               MatchSoundsLike:=False, MatchAllWordForms:=False, _ 
               Forward:=True, Wrap:=wdFindStop, Format:=True, _ 
               ReplaceWith:="", Replace:=wdReplaceNone, _ 
               MatchKashida:=False, MatchDiacritics:=False, _ 
               MatchAlefHamza:=False, MatchControl:=False) 

         'Take note if it was italic 
         BlnWasItalic = WdSlct.Font.Italic 

         'Make the replacement 
         WdSlct = ChrW(AryTemp(1)) 

         'Remember the location (in case there are due to be more than 
         'one change in one word 
         LngLocation = WdSlct.End 

         'Expand the selection to the whole word 
         WdSlct.Expand wdWord 

         'Set the font 
         WdSlct.Font.Name = "Arial Unicode MS" 

         'Set the word to be italic if it was meant to be 
         WdSlct.Font.Italic = BlnWasItalic 

         'Move past the word 
         WdSlct.SetRange LngLocation, LngLocation 
        Loop 
       Set WdFnd = Nothing 
      Set WdSlct = Nothing 
      DoEvents 
     Next 
     DoEvents 
    Next 
Set WdDoc = Nothing 
End Sub 

(Dieser Code ist nicht getestet und ausgebildet, um eine Lösung exemplifizieren)