时间戳

首页 > 解决方案 > 创建标题的脚本

vba - 创建标题的脚本

问题描述

我有一个由 DOORS 创建的 Word 文档，其中表格中的标题写为“1”、“1.1”、“2.2.3”等（见图）。

单词表

有没有办法编写宏或 vba 脚本来搜索给定列中以数字开头的单元格并删除该数字并为该行应用一种样式？
例如：

提前致谢。

亲切的问候，克劳斯

标签： vbams-word

解决方案

刷代码。工作相同。

公共函数 getHeadingNumber(ByRef s As String) As Integer Dim i As Integer Dim ws As String

If s Like "#.#*" Then ' is it a heading (note: heading 1 are not found)
    i = InStr(s, " ") ' search for first space charater
    ws = Left(s, i) ' keep only digits and bullets in ws
    getHeadingNumber = 1 + Len(ws) - Len(Replace(ws, ".", "")) ' count number of bullets
    
    s = Right(s, Len(s) - i) ' keep only the 12 left most characters
    s = Replace(s, Chr(13), "") ' remove Carrige Return at end of string
Else
    getHeadingNumber = 0 ' not a heading
End If

结束功能

Sub ApplyHeadingStyles() Dim tbl As Table Dim tCell As Cell Dim r As Integer Dim heading As Integer Dim ws As String

For Each tbl In ActiveDocument.Tables
    For r = 1 To tbl.Rows.Count
        Set tCell = tbl.Cell(r, 3) ' check only row 3
        ws = tCell.Range.Text
        heading = getHeadingNumber(ws)
        If heading > 0 Then
            tCell.Range.Text = ws
            Select Case heading
                Case 1
                    tCell.Range.Style = ActiveDocument.Styles("Heading 1")
                Case 2
                    tCell.Range.Style = ActiveDocument.Styles("Heading 2")
                Case 3
                    tCell.Range.Style = ActiveDocument.Styles("Heading 3")
                Case 4
                    tCell.Range.Style = ActiveDocument.Styles("Heading 4")
                Case 5
                    tCell.Range.Style = ActiveDocument.Styles("Heading 5")
                Case 6
                    tCell.Range.Style = ActiveDocument.Styles("Heading 6")
            End Select
        End If
    Next r
Next tbl

' Set heading in "Test Description"
For Each tbl In ActiveDocument.Tables
    Set tCell = tbl.Cell(2, 3)
    If tCell.Range.Text Like "1*" Then ' search for heading
        tCell.Range.Text = Right(tCell.Range.Text, Len(tCell.Range.Text) - 2) ' remove old heading numbers
        tCell.Range.Text = Replace(tCell.Range.Text, Chr(13), "") ' remove Carrige Return at end of string
        tCell.Range.Style = ActiveDocument.Styles("Heading 1")
    End If
Next tbl

结束子

推荐阅读