Работа с таблицами

В этом разделе приведены примеры Visual Basic, связанные с задачами, определенными в следующих разделах.

Создание таблицы, вставка текста и применение форматирования

В следующем примере в начале активного документа вставляется таблица из четырех столбцов с тремя строками. Для каждого... Следующая структура используется для пошагового прохождения каждой ячейки в таблице. В элементе For Each... Следующая структура— метод InsertAfter объекта Range используется для добавления текста в ячейки таблицы (ячейка 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 вставляет текст "Ячейка 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" 
  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) 
  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

Возврат содержимого каждой ячейки таблицы

В следующем примере определяется массив, равный количеству ячеек в первой таблице документов (при условии , что параметр Base 1). Для каждого... Следующая структура используется для возврата содержимого каждой ячейки таблицы и назначения текста соответствующему элементу массива.

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

Копирование всех таблиц активного документа в новый документ

В этом примере таблицы из текущего документа копируются в новый документ.

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

Поддержка и обратная связь

Есть вопросы или отзывы, касающиеся Office VBA или этой статьи? Руководство по другим способам получения поддержки и отправки отзывов см. в статье Поддержка Office VBA и обратная связь.