【谢谢vbee老师】修改一个Word代码

roz

昨天发的帖子中http://club.excelhome.net/thread-1438584-1-1.html


vbee老师的代码只取第一个单词。实际上，我想取段首开头第一个下划线内容的所有字符呢，比如：

第一页读取了yer
第三页读取了vowel和word


下面这句想取的是absolute neutralisation ，实际上代码只能取第一个单词，就是absolute哈！
absolute neutralisation A form of neutralisationwhich was postulated in the historyof  generative phonology.  


另外，有时候会读取不是段首字符串的单词，不知道是不是我打开方式不对呢？
昨天没有及时检测代码，今天发现了bug，如有冒犯，向vbee老师说声抱歉哈！


下面是vbee老师的代码：

1. <font face="Arial" size="3">Sub vbee2()
   
2. Dim P As Paragraph
   
3. For Each P In ActiveDocument.Paragraphs
   
4.   For i = 1 To P.Range.Words.Count
   
5.     If P.Range.Words(i).Font.Underline = wdUnderlineSingle Then
   
6.        H = H & P.Range.Words(i).Text & " | " & P.Range.Words(i).Information(wdActiveEndPageNumber) & vbCrLf
   
7.     Exit For
   
8.     End If
   
9.   Next
   
10. Next
    
11. ActiveDocument.Content.InsertAfter vbCrLf & "*******************************************" & vbCrLf & H
    
12. 
    
13. End Sub
    
14. </font>

复制代码

希望小哥哥帮忙！谢谢咯！

vbee

1. Sub vbee2()
   
2. On Error Resume Next
   
3. Dim P As Paragraph
   
4. For Each P In ActiveDocument.Paragraphs
   
5. w = ""
   
6.   For i = 1 To P.Range.Words.Count
   
7.     If P.Range.Words(i).Font.Underline = wdUnderlineSingle Then
   
8.        w = w & P.Range.Words(i).Text & " "
   
9.     Else: If Len(w) > 2 Then Exit For
   
10.     End If
    
11.   Next
    
12.   H = H & w & " | " & P.Range.Words(i).Information(wdActiveEndPageNumber) & vbCrLf
    
13. Next
    
14. ActiveDocument.Content.InsertAfter vbCrLf & "*******************************************" & vbCrLf & H
    
15. 
    
16. End Sub
    

复制代码

roz

vbee 发表于 2018-10-4 08:25

谢谢vbee老师，好厉害哦！

可以增加一个条件吗？如果下划线内容不是在每段开头（从第一个字符开始），就不要这个词头了。

之前我没说清楚哈，不好意思！

vbee

如果下划线内容不是在每段开头（从第一个字符开始），就不要这个词头了。

1. Sub vbee3()
   
2. On Error Resume Next
   
3. Dim P As Paragraph
   
4. For Each P In ActiveDocument.Paragraphs
   
5. w = ""
   
6.   For i = 1 To P.Range.Words.Count
   
7.     If P.Range.Words(i).Font.Underline = wdUnderlineSingle Then
   
8.        w = w & P.Range.Words(i).Text & " "
   
9.     Else: Exit For
   
10.     End If
    
11.   Next
    
12.   If Len(w) > 1 Then H = H & w & " | " & P.Range.Words(i).Information(wdActiveEndPageNumber) & vbCrLf
    
13. Next
    
14. ActiveDocument.Content.InsertAfter vbCrLf & "*******************************************" & vbCrLf & H
    
15. 
    
16. End Sub
    

复制代码