найти курсивные шрифты в текстовом документе, используя VBA

Question

С помощью функции Find (Ctrl+F) я могу искать и выбирать все слова, выделенные курсивом, из документа. Как это можно сделать с помощью VBA?

Я пробовал устройство записи макросов, но код, который я там получаю, не работает.

Sub Makro1()
'
' Makro1 Makro
' Makro aufgezeichnet am 16.06.2011 von u0327336
'
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
End Sub

Цель состоит в том, чтобы в документе были выделены / выделены все слова курсива.

спасибо, кай

Answer 1

Последнее усилие действительно работает в Word 2010. Я не уверен, почему в отчете говорилось, что оно не сработало.

Здесь оно заменено курсивом ASCIIfy, чего я и хочу для текстовых групп новостей:

 Sub ASCIIfy()
    Dim myString As Word.Range
    Set myString = ActiveDocument.Content
    With myString.Find
        '// ensure unwanted formats aren't included as criteria
        .ClearFormatting
        '// we don't care what the text is
        .Text = ""
        '// find the italic text
        .Font.Italic = True
        '// loop for each match and surround with "_"
        While .Execute
            myString.Text = "_" & myString & "_"
            myString.Font.Italic = False
            myString.Collapse wdCollapseEnd
        Wend
    End With
End Sub

Answer 2

Set Selection.Find.Font.Italic = True.

Selection.Find.ClearFormatting

' The next line does the trick.
Selection.Find.Font.Italic = True

With Selection.Find
    .Text = "YourText"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute

Подсказка на следующий раз: запишите макрос, выполните действия, которые вы хотите автоматизировать, и посмотрите, какой код записан. Вот как я это нашел. : D

[править]

Я вижу, что вы пытались записать это. Странно, что это не сработало ..: -S

Answer 3

Возможно, вам понадобится добавить:

Selection.Find.Font.Italic = True

Это может стать:

With Selection.Find
   .Text = ""
   .FOnt.Italic = True
   'other search stuff
End with

РЕДАКТИРОВАТЬ : еще одна попытка (хотя и не полная)

Sub hilightItalic()
    With ActiveDocument.Content.Find
        ' to ensure that unwanted formats aren't included as criteria
        .ClearFormatting
        'You don't care what the text is
        .Text = ""
        'Find the italic text
        .Font.Italic = True
        'Delete the text found
        .Replacement.Text = ""
        'delete all italic text
        .Execute Replace:=wdReplaceAll
        '.HitHighlight "", vbYellow, vbRed
    End With
End Sub

Но замена работает хорошо, но выделение не работает, если нет текста.У кого-нибудь есть идея?

РЕДАКТИРОВАТЬ 2 : Нашел работающее решение, даже если мне не удавалось работать с подсветкой, хотя

Sub hilightItalic()
    Dim oRng As Word.Range
    Set oRng = ActiveDocument.Content
    With oRng.Find
        ' to ensure that unwanted formats aren't included as criteria
        .ClearFormatting
        'You don't care what the text is
        .Text = ""
        'Find the italic text
        .Font.Italic = True
        'Loop for each match and set a color
        While .Execute
            oRng.HighlightColorIndex = wdDarkYellow
            oRng.Collapse wdCollapseEnd
        Wend
    End With
End Sub

С уважением

Макс

Answer 4

Вам нужно перебрать ячейки в диапазоне, который вы хотите проверить, и, в частности, проверить, выделен ли его курсив шрифтом. AFAIK .Italic не является "доступной" опцией.

Следующий код является примером итерации по ячейкам, чтобы найти то, что вам нужно.

Sub TestMe2()

Dim rng As Range

'// change as needed to the proper worksheet reference
With ThisWorkbook.Worksheets(1)

    '// replace the .Range statement with an appropriate range for your data
    For Each rng In .Range(.Cells(1, 1), .Cells(100, 100))

        If rng.Font.Italic = True Then
            '// uses the yellow highlight color, change to suit your needs
            rng.Interior.Color = 65535
        End If

    Next rng
End With

End Sub