分享

Word表格之VBA知识

 gblhp 2015-03-31

Table 对象(因为是对象,所以用Set赋值)

该对象代表一个单独的表格。Table 对象是Tables集合的一个成员。Tables集合包含了指定的选定内容范围文档中的所有表格

下面是Table的常用方法(注意是部分,不是全部,只例出重要的方法,下面的属性皆如此,如果详细面全部的了解,请看Word VBA自带的帮助。VBAWD10.chm

使用Table对象

可使用 Tables(index) 返回一个 Table 对象,其中 index 为索引号。索引号代表选定内容、范围或文档中表格的位置。下例将活动文档中的第一个表格转换为文本。

ActiveDocument.Tables(1).ConvertToText Separator:=wdSeparateByTabs

使用Add方法可以在指定范围内新增一表格。下例在活动文档的起始处添加一 3 x 4 表格。

Set myRange = ActiveDocument.Range(Start:=0, End:=0)

ActiveDocument.Tables.Add Range:=myRange, NumRows:=3, NumColumns:=4

Cell 方法

返回一个 Cell 对象,该对象代表表格中的一个单元格

expression.Cell(Row, Column)

expression      必需。该表达式返回一个Table对象。

Row   Long 类型,必需。指返回的表格行数。可以是介于 1 和表格行数之间的任意整数。

Column    Long 类型,必需。指返回的表格单元格数目。可以是介于 1 和表格列数之间的任意整数。

示例

本示例在新文档中创建一个 33 表格,并在表格的第一个和最后一个单元格中插入文本。

Dim docNew As Document

Dim tableNew As Table

Set docNew = Documents.Add

Set tableNew = docNew.Tables.Add(Selection.Range, 3, 3)

With tableNew

    .Cell(1,1).Range.InsertAfter "First cell"

    .Cell(tableNew.Rows.Count, _

        tableNew.Columns.Count).Range.InsertAfter "Last Cell"

End With

本示例删除活动文档的第一个表格中的第一个单元格的内容。

If ActiveDocument.Tables.Count >= 1 Then

    ActiveDocument.Tables(1).Cell(1, 1).Delete

End If

Split 方法

在表格中紧靠指定行的上面插入一空段落,并且返回一个 Table 对象,此对象包含指定行及其下一行。(简单的的理解:就是指向拆分后的下面的表格,不清楚也没关系,看下面的。)

expression.Split(BeforeRow)

expression      必需。该表达式返回一个 Table 对象。

BeforeRow     Variant 类型,必需。将要拆分的表格的前一行。可以为 Row 对象或行号。

本示例在活动文档(应试是新建文档)中创建一张 5x5 的表格,并且在第三行之前进行拆分。然后为结果表格(新的 3x5 表格)的单元格添加底纹。

Set newDoc = Documents.Add

Set myTable = ActiveDocument.Tables.Add(Range:=Selection.Range, _

    NumColumns:=5, NumRows:=5)

myTable.Split(BeforeRow:=myTable.Rows(3)).Shading _

    .Texture = wdTexture10Percent

Table属性

Range 属性

本示例复制表格 1 中的首行。

 

If ActiveDocument.Tables.Count >= 1 Then _

    ActiveDocument.Tables(1).Rows(1).Range.Copy

End if

Borders 属性

该属性返回一个 Borders 集合,该集合代表指定对象的所有边框。

expression.Borders

expression      必需。该表达式返回“应用于”列表中的一个对象。

示例

本示例对活动文档中的第一个表格应用内部和外部边框。

Set myTable = ActiveDocument.Tables(1)

With myTable.Borders

    .InsideLineStyle = wdLineStyleSingle

    .OutsideLineStyle = wdLineStyleDouble

End With

Columns 属性

返回一个 Columns 集合,该集合代表在某一区域、所选内容或表格中所有表格列。只读

示例

本示例显示活动文档的第一个表格中的列数。

If ActiveDocument.Tables.Count >= 1 Then

    MsgBox ActiveDocument.Tables(1).Columns.Count

End If

本示例将当前列的宽度设置为 1 英寸

If Selection.Information(wdWithInTable) = True Then

    Selection.Columns.SetWidth ColumnWidth:=InchesToPoints(1), _

        RulerStyle:=wdAdjustProportional

End If

Rows 属性

该属性返回一个 Rows 集合,该集合代表某个范围、所选部分或表格中所有的表格行。只读。

本示例删除活动文档第一个表格的第二行。

ActiveDocument.Tables(1).Rows(2).Delete

本示例为插入点所在行的各单元格设置边框。

Selection.Collapse Direction:=wdCollapseStart

If Selection.Information(wdWithInTable) = True Then

    Selection.Rows(1).Borders.OutsideLineStyle =  wdLineStyleSingle

Else

    MsgBox "The insertion point is not in a table."

End If

Column 对象

代表单个表格列。Column 对象是 Columns 集合的一个元素。Columns 集合包括某一表格、选定内容或区域中的所有列。

使用 Column 对象

使用 Columns(index) 可返回单独的 Column 对象,其中 index 为索引序号。索引序号代表该列在 Columns 集合中的位置(从左至右计算)

下列示例选定活动文档中的表格 1 的第一列。

ActiveDocument.Tables(1).Columns(1).Select

Cell 对象的 Column 属性可返回一个 Column 对象。下列示例删除单元格 1 中的文字,插入新文字,然后对该列进行排序。

With ActiveDocument.Tables(1).Cell(1, 1)

    .Range.Delete

    .Range.InsertBefore "Sales"

    .Column.Sort

End With

Add 方法可在表格中添加一列。下列示例为活动文档的第一张表格中添加一列,然后将列宽设置为相等。

If ActiveDocument.Tables.Count >= 1 Then

    Set myTable = ActiveDocument.Tables(1)

    myTable.Columns.Add BeforeColumn:=myTable.Columns(1)

    myTable.Columns.DistributeWidth

End If

说明

Selection 对象的 Information 属性可返回当前列号。下列示例选定当前列并在消息框中显示其列号。

If Selection.Information(wdWithInTable) = True Then

    Selection.Columns(1).Select

    MsgBox "Column " _

        & Selection.Information(wdStartOfRangeColumnNumber)

End If

Cell 对象

代表单个表格单元格。Cell 对象是 Cells 集合中的元素。Cells 集合代表指定对象中所有的单元格。

使用 Cell 对象

Cell(row, column) Cells(index)可返回 Cell 对象,其中 row 为行号,column 为列号,index 为索引序号。下列示例给第一行的第二个单元格加底纹。

Set myCell = ActiveDocument.Tables(1).Cell(Row:=1, Column:=2)

myCell.Shading.Texture = wdTexture20Percent

下列示例给第一行的第一个单元格加底纹。

ActiveDocument.Tables(1).Rows(1).Cells(1).Shading _

    .Texture = wdTexture20Percent

Add 方法可在 Cells 集合中添加 Cell 对象。也可用 Selection 对象的 InsertCells 方法插入新单元格。下列示例在 myTable 的第一个单元格之前插入一个单元格。

Set myTable = ActiveDocument.Tables(1)

myTable.Range.Cells.Add BeforeCell:=myTable.Cell(1, 1)

本示例将第一个表格的头两个单元格设定为一个域 (myRange)。区域设定之后,用 Merge 方法合并两个单元格。

Set myTable = ActiveDocument.Tables(1)

Set myRange = ActiveDocument.Range(myTable.Cell(1, 1) _

    .Range.Start, myTable.Cell(1, 2).Range.End)

myRange.Cells.Merge

说明

使用带 Rows Columns 集合的 Add 方法添加一行或一列单元格。

使用 Selection 对象的 Information 属性返回当前行号和列号。下面的示例改变选中部分第一个单元格的宽度,再显示单元格的行号和列号。

If Selection.Information(wdWithInTable) = True Then

    With Selection

        .Cells(1).Width = 22

        MsgBox "Cell " & .Information(wdStartOfRangeRowNumber) _

            & "," & .Information(wdStartOfRangeColumnNumber)

    End With

End If

Row 对象

代表表格的一行。Row 对象是 Rows 集合中的一个元素。Rows 集合包括指定部分、区域或表格中的所有行。

使用 Row 对象

Rows(index) 可返回单独的 Row 对象,其中 index 为索引序号。索引序号代表该行在选定部分、区域或表格中的位置。下列示例删除活动文档中第一张表格的首行。

ActiveDocument.Tables(1).Rows(1).Delete

Add 方法可在表格中添加行。下列示例在选定部分首行前插入一行。

If Selection.Information(wdWithInTable) = True Then

    Selection.Rows.Add BeforeRow:=Selection.Rows(1)

End If

说明

Cells 属性可修改 Row 对象中的单个单元格。下列示例在选定部分中添加一张表格,并在表格第二行的各单元格内插入数字。

Selection.Collapse Direction:=wdCollapseEnd

If Selection.Information(wdWithInTable) = False Then

    Set myTable = _

        ActiveDocument.Tables.Add(Range:=Selection.Range, _

        NumRows:=3, NumColumns:=5)

    For Each aCell In myTable.Rows(2).Cells

        i = i + 1

        aCell.Range.Text = i

    Next aCell

End If

访问表格行或列时产生的错误

如果要访问绘制表格中单独的行或列,而该表格又不统一,则会产生一个运行时错误。例如,如果活动文档中第一张表格的每列中具有不同数量的行,则使用下列指令将导致出错。

Sub RemoveTableBorders()

    ActiveDocument.Tables(1).Rows(1).Borders.Enable = False

End Sub

要避免这种错误可首先使用 SelectColumn SelectRow 方法选定一列或一行中的单元格。选定单元格后,再使用 Selection 对象的 Cells 属性。下列示例选定第一张文档表格中的第一行。Cells 属性用于访问选定的单元格(第一行中的所有单元格)以删除边框。

Sub RemoveTableBorders()

    ActiveDocument.Tables(1).Cell(1, 1).Select

    With Selection

        .SelectRow

        .Cells.Borders.Enable = False

    End With

End Sub

下列示例选定第一张文档表格的第一列。For Each...Next 循环语句用于在所选内容(第一列中的所有单元格)的每个单元格中添加文字。

Sub AddTextToTableCells()

    Dim intCell As Integer

    Dim oCell As Cell

    ActiveDocument.Tables(1).Cell(1, 1).Select

    Selection.SelectColumn

    intCell = 1

    For Each oCell In Selection.Cells

        oCell.Range.Text = "Cell " & intCell

        intCell = intCell + 1

    Next oCell

End Sub

处理表格

创建一张表格,插入文字,并应用格式

下列示例在活动文档的开头插入一张 4 3 行的表格。For Each...Next 结构用于循环遍历表格中的每个单元格。在 For Each...Next 结构中,InsertAfter 方法用于将文字添至表格单元格(单元格 1、单元格 2、以此类推)。

Sub CreateNewTable()

    Dim docActive As Document

    Dim tblNew As Table

    Dim celTable As Cell

    Dim intCount As Integer

    Set docActive = ActiveDocument

    Set tblNew = docActive.Tables.Add( _

        Range:=docActive.Range(Start:=0, End:=0), NumRows:=3, _

        NumColumns:=4)

    intCount = 1

    For Each celTable In tblNew.Range.Cells

        celTable.Range.InsertAfter "Cell " & intCount

        intCount = intCount + 1

    Next celTable

    tblNew.AutoFormat Format:=wdTableFormatColorful2, _

        ApplyBorders:=True, ApplyFont:=True, ApplyColor:=True

End Sub

在表格单元格中插入文字

下列示例在活动文档中第一张表格的第一个单元格中插入文字。Cell 方法返回单独的 Cell 对象。Range 属性返回一个 Range 对象。Delete 方法用于删除现有的文字,而 InsertAfter 方法用于插入文字“Cell 1,1

Sub InsertTextInCell()

    If ActiveDocument.Tables.Count >= 1 Then

        With ActiveDocument.Tables(1).Cell(Row:=1, Column:=1).Range

            .Delete

            .InsertAfter Text:="Cell 1,1"

           ' .text="cell 1,1" 上面两行,可以用这一行表示。

        End With

    End If

End Sub

返回表格单元格中的文字,不包括表格结束单元格标记

下列示例返回并显示文档中第一张表格的第一行中每个单元格的内容。

Sub ReturnTableText()

    Dim tblOne As Table

    Dim celTable As Cell

    Dim rngTable As Range

    Set tblOne = ActiveDocument.Tables(1)

    For Each celTable In tblOne.Rows(1).Cells

        Set rngTable = ActiveDocument.Range(Start:=celTable.Range.Start, _

            End:=celTable.Range.End - 1)         '注意这里用了-1

        MsgBox rngTable.Text

    Next celTable

End Sub

 

Sub ReturnCellText()

    Dim tblOne As Table

    Dim celTable As Cell

    Dim rngTable As Range

    Set tblOne = ActiveDocument.Tables(1)

    For Each celTable In tblOne.Rows(1).Cells

        Set rngTable = celTable.Range

        rngTable.MoveEnd Unit:=wdCharacter, Count:=-1

        MsgBox rngTable.Text

    Next celTable

End Sub

 

将文本转换为表格

下列示例在活动文档的开头插入用制表符分隔的文本,然后将这些文本转换为表格。

Sub ConvertExistingText()

    With Documents.Add.Content

        .InsertBefore "one" & vbTab & "two" & vbTab & "three" & vbCr

        .ConvertToTable Separator:=Chr(9), NumRows:=1, NumColumns:=3

    End With

End Sub

 

返回每个表格单元格的内容

下列示例定义一个数组,该数组的元素个数等于文档中第一张表格(假定为 Option Base 1)中的单元格数。For Each...Next 结构用于返回每个表格单元格的内容,并将文字指定给相应的数组元素。

Sub ReturnCellContentsToArray()

    Dim intCells As Integer

    Dim celTable As Cell

    Dim strCells() As String

    Dim intCount As Integer

    Dim rngText As Range

    If ActiveDocument.Tables.Count >= 1 Then

        With ActiveDocument.Tables(1).Range

            intCells = .Cells.Count

            ReDim strCells(intCells)

            intCount = 1

            For Each celTable In .Cells

                Set rngText = celTable.Range

                rngText.MoveEnd Unit:=wdCharacter, Count:=-1

                strCells(intCount) = rngText

                intCount = intCount + 1

            Next celTable

        End With

    End If

End Sub

(测试环境.docVBA中有更好的方法,可以参考)

将活动文档中的所有表格复制到新文档中

本示例将当前文档中的表格复制到新文档中。

Sub CopyTablesToNewDoc()

    Dim docOld As Document

    Dim rngDoc As Range

    Dim tblDoc As Table

    If ActiveDocument.Tables.Count >= 1 Then

        Set docOld = ActiveDocument

        Set rngDoc = Documents.Add.Range(Start:=0, End:=0)

        For Each tblDoc In docOld.Tables

            tblDoc.Range.Copy

            With rngDoc

                .Paste

                .Collapse Direction:=wdCollapseEnd

                .InsertParagraphAfter

                .Collapse Direction:=wdCollapseEnd

            End With

        Next

    End If

End Sub

 

以下为我对表格的认识:(陋见)

在“测试环境.doc”中有不少的例子(在VBA中),也有解释,

两个文档花了我8小时以上(即一个工作日以上)

关于表格在VBA中的相关说明:

1.         如下图,类似于回车 VBA中也是chr(13),竖线就是chr(7),怎么知道的?

2.         当然是看老大们知道的。不过。在“测试环境.doc”中有相关的宏能得到这些数字。这也是授之以渔吧。

3.         重点推荐“测试环境.doc的相关代码用了我不少功夫,慢慢体会。不懂的可以提出来。

Ch(13)

Ch(7)

4.         因为chr(13)为段落标记,所以在VBA中,ActiveDocument.Paragraphs.Count测得的段落数与工具、字数统计是不一样的。

5.         如果这样统计:表格中单元格中类似的 且不为空就为一个段落,否则不算。这就与工工具、字数统计的段落数一样了。

6.         如果要新建一个表格,再添加一些字符(包括数字)的话,更好的方法是:先字符写入文档中(当然,要加一些标记,以便确定单元格),再利用Word的表格、转换、文字转换为表格。这样,速度快一些。有以下的代码为证。

Sub 表格5()

'先放到文档,再放入表格

Dim i%, astring As String

Dim adoc As Document

Dim atime As Long

Application.ScreenUpdating = False '关闭屏幕更新

atime = Timer 'atime为正前时间

For i = 1 To 1000

    astring = astring & i & Chr(13)

Next

    Set adoc = Documents.Add

        adoc.Content = astring

        adoc.Range.ConvertToTable Separator:=wdSeparateByParagraphs, NumColumns:=10, _

        NumRows:=100

Application.ScreenUpdating = True

    MsgBox "先放到文档的运行时间为:" & Timer - atime

    '1.28,1.07,1.03

End Sub

Sub 表格6()

'先生成表格,再向单元格中添数

Dim i%, astring As String

Dim adoc As Document

Dim atime As Long

Dim atable As Table

Application.ScreenUpdating = False '关闭屏幕更新

atime = Timer 'atime为正前时间

Set adoc = Documents.Add

Set atable = adoc.Tables.Add(Selection.Range, 100, 10)

With atable.Range

    For i = 1 To 1000

        .Cells(i).Range.Text = i

    Next

End With

Application.ScreenUpdating = True

    MsgBox "先放到文档的运行时间为:" & Timer - atime

    '16.3,15.53,15.35

End Sub

'几乎是15倍的差别,谁快谁慢应该大家知道了。还顺带说一话:有的软件在操作Word的表格时,就是用类似于“表格6的方法,而且也没有用Appplication.ScreenUpdating=true。所以,看上去就像在看动画片。(例如:“青山预算之星”的“输出到Word”就是)看来,国产软件还需努力。

7.         有些尤意末尽的,大家慢慢在程序中体会。

8.         特别强调:微软本身的许多功能,不是一般的VBA的程序,比VBA要快很多,不明白内部是用什么语言或什么原理在工作。例如:a.邮件合并,速度奇快。如果你试着用VBA来做,速度奇慢。b.修订功能;c.工具、宏、命令listcommands的运行速度。
等等,都是我们VBA一族所不能及的。(不过来,如果我们的VBA与微软快,微软不PK我们才怪。呵呵,阿Q精神一下,找一下心理平衡。) 

    本站是提供个人知识管理的网络存储空间,所有内容均由用户发布,不代表本站观点。请注意甄别内容中的联系方式、诱导购买等信息,谨防诈骗。如发现有害或侵权内容,请点击一键举报。
    转藏 分享 献花(0

    0条评论

    发表

    请遵守用户 评论公约

    类似文章 更多