对个word文档的循环发现所有加粗的

Sub gisoracle()

Dim firstChar As Variant

Dim p As Paragraph
For Each p In ActiveDocument.Paragraphs
   Set firstChar = p.Range.Words(1)
  
  
If firstChar.Bold = True Then
    MsgBox firstChar
   
   
End If

Next
End Sub

8月18日

speedfirst's VBA教程8：提取Word中未样式化的标题

在本期中，我会将注意力放在Word上。网友dinosaurhxe曾经提出了一个问题：他们单位的老干部不是太会用Word，写标题的时候完全没理会标题样式，全部用了正文。每个标题分为三部分：标号、中文标题和英文标题。dinosaurhxe很苦恼，因为领导要求它产生三份列表，分别以标号、中文标题和英文标题排序，同时结果还要包含标题对应的页码。这样的话，就必须把这些标题全提取出来——那可是好几百页啊。不过，尽管老干部们不会用样式，还是留下了一些线索——标题都很工整的被分为以上三个部分，均以空格隔开，并且全被设为了粗体。问题的数据规模比较大，问题没有通用的解法，并且很有规律。这刚好符合VBA施展功力的条件。

我将这个问题的解决方案定为：如果碰到了一段的段首是粗体的数字，就认为这个东西是标题。当然，这里可以加很多条件来使得结果更不容易错，比如最大长度不能超过某某值等。将标题拆解后放到Excel中，每个部分一列，这样想怎么排序都可以了。VBA的代码写在Word中。依照老规矩，还是先看看有哪些子问题需要解决。

1. 如何操作Word文档，并且一段段的遍历这个文档？
2. 如何获得每段的第一个字符？
3. 如何判断字符是粗体？
4. 如何判断字符是数字？
5. 如何拆解一段文字（比如用空格作为分隔符）？
6. 怎么获得标题对应的页码？
7. 如何填写Excel数据表？

对于问题1，非常类似于Excel的ActiveWorkbook，Word中也有ActiveDocument可以获得当前的文档。在Document类型中有一个Paragraphs集合，包含了Word文档中所有的段落。这样，很轻松的可以用

Dim p As Paragraph
For Each p In ActiveDocument.Paragraphs
    'do something...
Next

来遍历段落了。

对于问题2，每个段落对象中都有一个Range对象。在Excel中Range表示一个或者多个单元格；但在Word中，Range代表了一段文字。Paragraph.Range就代表了整段文字。而Word的Range对象中有一个Characters集合，表示了每个字符。那么Characters(1)就是Range的第一个字符。所以，段落p的第一个字符就是这么取得的：

Dim firstChar As Character
Set firstChar = p.Range.Characters(1)

对于问题3，Character对象有一组布尔属性来表示Character的格式，比如粗体就是Character.Bold；斜体是Character.Italic；下划线就是Character.Underline。那么判断firstChar是不是粗体的语句就是：

If firstChar.Bold = True Then
    'do something...
End If

对于问题4，VBA本身提供了IsNumeric函数来判断一个字符串是否是数字。如果IsNumeric(firstChar.Text)为真，则就是数字。

对于问题5，可以使用VBA本身提供的Split函数。这个函数在前面几期多次提到了，就不赘述了。

对于问题6，Word本身提供的访问方式并不是那么直观。因为只有Selection对象的Information函数才能获得一个段落所在的页码。在Word当中Selection对象就是Selection类型的，不像Excel中的Selection对象那样是Range类型的。在Word中Selection和Range是两种不同的对象，尽管它们很多地方很相似，但是还是有一些不同，比如Range就没有Information函数。这样，为了获得一个段落的页码，必须首先选中这个段落，然后利用wdActiveEndAdjustedPageNumber参数来调用Information函数，就像是这样：

p.Range.Select
pageNum = Selection.Information(wdActiveEndAdjustedPageNumber)

所谓ActiveEndAdjused是指获取选中区域结尾所在的（因为一个段落可能跨页），经过调整过的页码。所谓调整是指，如果对文档分了节，并做了页码设置（如首页页码不是1，或者加了分页符），就返回设置后得到的页码。如果只想要那种文档第一页为1，忽略任何页码设置的页码，可以改用wdActiveEndPageNumber。更多的枚举值可以看这里。ms-help://MS.WINWORD.DEV.12.2052/WINWORD.DEV/content/HV10076103.htm

对于问题7，相信经过那么多次的教程，这个就没有必要再讲了。详细的程序如下所示：

Sub ExtractTitle()
    Dim p As Paragraph
    Dim firstChar As Range
    Dim num As String, chTitle As String, enTitle As String 'title number, Chinese title, English Title
    Dim pageNum As Integer ' page number of a title
    'Start excel
    Dim excelApp As New Excel.Application
    excelApp.Visible = True
    Dim sheet As Worksheet
    Set sheet = excelApp.Workbooks.Add.Worksheets(1)
    'Write header
    sheet.Range("A1").Value = "序号"
    sheet.Range("B1").Value = "中文标题"
    sheet.Range("C1").Value = "英文标题"
    sheet.Range("D1").Value = "页码"
    i = 2
    For Each p In ActiveDocument.Paragraphs
        Set firstChar = p.Range.Characters(1) 'Get the first character
        If firstChar.Bold = True And IsNumeric(firstChar.Text) Then 'if it is bold and a number
            'Split with white space
            items = Split(p.Range.Text, " ")
            num = items(0)
            chTitle = items(1)
            enTitle = Right(p.Range.Text, Len(p.Range.Text) - Len(num) - Len(chTitle) - 2)
            p.Range.Select
            pageNum = Selection.Information(wdActiveEndAdjustedPageNumber)
            'put those information to excel
            sheet.Range("A" & i).Value = num
            sheet.Range("B" & i).Value = chTitle
            sheet.Range("C" & i).Value = enTitle
            sheet.Range("D" & i).Value = pageNum
        End If
    Next
End Sub

其中，首先新建了一个Excel文档（这部分的正常运行需要你在Word的VBA项目中添加对Microsoft Excel Object Library的引用），把Excel工作表中的列头写上。然后开始遍历每个段落，如果一个段落的第一个字符是粗体，并且是数字，我们就认为它是标题。然后，利用Split拆分了这个段落的问童子。第一部分显然是标题号；第二部分是中文标题；余下的所有部分都是英文标题，这是因为英文本身就会有很多空格。这段代码利用Right函数完成了对英文标题的截取：

enTitle = Right(p.Range.Text, Len(p.Range.Text) - Len(num) - Len(chTitle) - 2)

最后，利用Selection.Information得到了标题的页码。所有这些信息都写入到Excel工作表的ABCD四列中。当遍历完所有的段落，就大功告成了。

最后附上一个简化的Word对象结构模型图，方便大家找到Word中的各个对象，并在VBA中使用。

 来自：http://speedfirst.spaces.live.com/blog/cns!5D6E8B35D225421F!323.entry

http://speedfirst.spaces.live.com/blog/cns!5D6E8B35D225421F!323.entry