我正在寻找是否可以创建一个宏来查找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
答案 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