在VBA Word

时间:2016-08-25 15:53:36

标签: vba ms-word word-vba

我正在寻找是否可以创建一个宏来查找word文档中带下划线的单词并将它们转换为html标记。我试图录制一个宏来做到这一点,但它只是为所有单词添加标签。我还提供了一些我试图使用的代码:

Dim myWords()       As String
Dim i               As Long
Dim myDoc           As Document: Set myDoc = ActiveDocument ' Change as needed
Dim aRange          As Range: Set aRange = myDoc.Content
Dim sRanges         As StoryRanges: Set sRanges = myDoc.StoryRanges
Dim ArrayCounter    As Long: ArrayCounter = 0 ' counter for items added to the array
Dim Sentence        As Range
Dim w               As Variant

Application.ScreenUpdating = False
ReDim myWords(aRange.Words.Count) ' set a array as large as the
                                  ' number of words in the doc

For Each Sentence In myDoc.StoryRanges
    For Each w In Sentence.Words
        If w.Font.Underline <> wdUnderlineNone Then
            myDoc.Sentence.Range.InsertBefore "<u>"
            myDoc.Sentence.Range.InsertAfter "</u>"
        End If

1 个答案:

答案 0 :(得分:1)

这段代码好像是familiar

以下是对您已完成的内容的调整,应该在每个带下划线的字词周围添加标记。需要注意的是,必须删除下划线属性,然后添加标记。否则word会将新引入的标记视为新单词,并重复该过程。

Sub ChangeUnderLineToHTML()
    Dim myDoc           As Document: Set myDoc = ActiveDocument ' Change as needed
    Dim aRange          As Range: Set aRange = myDoc.Content ' Change as needed
    Dim sRanges         As Variant: Set sRanges = myDoc.StoryRanges
    Dim sentence        As Object
    Dim w               As Object

    For Each sentence In sRanges
        For Each w In sentence.Words
            If w.Font.Underline <> wdUnderlineNone Then
                w.Font.Underline = wdUnderlineNone
                w.Text = "<u>" & w.Text & "</u>"
            End If
        Next w
    Next sentence

    'Clean Up
    Set myDoc = Nothing
    Set aRange = Nothing
    Set sRanges = Nothing
    Set w = Nothing
    Set sentence = Nothing
End Sub