Работа с таблицами Word с объединенными ячейками

В статьях, посвященных работе с таблицами Word, как правило, авторы избегают тем, касающихся объединенных ячеек. Оно и понятно: любое обращение к ячейке таблицы, находящейся в объединенной области, приводит к возникновению ошибки. Это внутренняя проблема редактора Word, связанная с архитектурой таблицы, и с этим ничего не поделаешь.

Однажды потребовалось перевести в базу данных нормативные данные, оформленные в редакторе Word в виде таблиц. И сразу же возникли проблемы с объединенными ячейками - как заполучить данные, находящиеся в объединенных ячейках.

Но, оказывается, именно возникновение исключений при обращении к отсутствующим ячейкам и позволяет решить эту проблему. Логика простая: раз возникло исключение при обращении к какой-либо ячейке, значит с этой ячейкой не все гладко. Значит, надо этим воспользоваться. На этом принципе основана методика распознавания таблиц Word, представленная в данной статье.

Для начала создаем запись:

TWordTableCell = record
   Merged : boolean;//индикатор объединенности ячеек
   VertCellMerged : boolean;
   PrevMerCol : integer;
   NextMerCol : integer;
   EndMerRow : integer;
   EndMerCol : integer;
   CellWidth : single;//ширина ячейки
   CellHeight : single;
   TableLeft : single;
   Text : OleVariant;//содержимое ячейки. К сожалению, только текст.
end;

и массивный тип

TWordTableCells = array of array of TWordTableCell;

Данный массив будет характеризовать всю таблицу, а элементы массива - каждую ячейку. Что означают поля записи TWordTableCell, можно догадаться по названиям.

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

TMainForm = class(TForm)
…
    { Private declarations }
    WApp : WordApplication;
    FTable : Table;
    FMaxUsedRows : integer; //максимальное количество используемых строк в компоненте
    FMaxUsedCols : integer; //максимальное количество столбцов в компоненте

    FWordTableCell : TWordTableCells;//массив ячеек компонента
…
    procedure GetTable;//процедура считывает некоторые свойства ячеек таблицы Word в запись FWordTableCell
    procedure CalcWordTableProp;//процедура обрабатывает считанные данные
…
  public

    { Public declarations }
  end;

Ядром обработки таблицы является следующая процедура:

procedure TMainForm.GetTable;
var i,j, UndoCount : integer;
     NumRows, NumColumns : OleVariant;
     bool : boolean;

begin

  FTable := WApp.ActiveDocument.Tables.Item(1); //первая таблица активного документа
  FMaxUsedRows := FTable.Rows.Count;
  FMaxUsedCols := FTable.Columns.Count;

  SetLength(FWordTableCell,0, 0);
  SetLength(FWordTableCell,FMaxUsedRows+1, FMaxUsedCols+1);
  WApp.Visible := true;
  NumColumns := 1;

   for i := 1 to FMaxUsedRows do

     for j := 1 to FMaxUsedCols do
     begin
      FWordTableCell[i,j].VertCellMerged := false;
      try

          FTable.Cell(i,j).HeightRule := wdRowHeightAtLeast;

          if FTable.Cell(i,j).Width >= 99999 then
          begin
           NumRows := 1;
           UndoCount := 1;
           repeat

            inc(NumRows);
            inc(UndoCount);
            if (FTable.Cell(i,j).Width >= 99999) then
            begin
              bool := false;
              try

               try
                try
                 FTable.Cell(i,j).Split(NumRows, NumColumns);
                 NumRows := 1;
                except
                end;
               except

               end;
              except
              end;
            end
            else bool := true;
           until bool;
            FWordTableCell[i,j].CellWidth := FTable.Cell(i,j).Width;
            while UndoCount <> 1 do

             begin
              dec(UndoCount);
              WApp.ActiveDocument.Undo(EmptyParam);
             end;
          end else
          FWordTableCell[i,j].CellWidth := FTable.Cell(i,j).Width;
          FWordTableCell[i,j].CellHeight := FTable.Cell(i,j).Height;
          FWordTableCell[i,j].Merged := false;
          FWordTableCell[i,j].Text := FTable.Cell(i,j).Range;
        except
          FWordTableCell[i,j].CellWidth := 0;
          FWordTableCell[i,j].CellHeight := FTable.Rows.Height;
          FWordTableCell[i,j].Merged := true;
        end;
      FWordTableCell[i,j].PrevMerCol := -1;
      FWordTableCell[i,j].NextMerCol := -1;
     end;
  CalcWordTableProp;

end;

В этой процедуре выполняется последовательное обращение к ячейкам таблицы и формирование записи FWordTableCell для каждой ячейки, характеризующей считываемую таблицу Word (как ни странно, здесь необходима именно тройная упаковка в try except end). Нужно обратить внимание, что некоторые ячейки приходится разбивать, т.к. для них невозможно определить никаких данных. (К сожалению, при прогонке программы в ручном режиме клавишами F7, F8 или F9, всегда возникает сообщение об ошибке, даже если отключить Tools->Debugger Option->Language Exception

Stop on Delphi Exception). Как видно из кода, инициализируются не все поля записи FWordTableCell. Для определения остальных полей производится обработка данных в процедуре CalcWordTableProp:

procedure TMainForm.CalcWordTableProp;
var i, j, k, N, EndCol: integer;
    FTableWidth : single;

  procedure CalcTableVertMergedInfo(i,j:integer);
  var Col : integer;
  begin

   for Col := 1 to FMaxUsedCols do
      if ((abs(FWordTableCell[i-1,Col].TableLeft-
                  FWordTableCell[i,j].TableLeft) <= 1) and

                  (FWordTableCell[i-1,Col].CellWidth <> 0))then
        begin
         FWordTableCell[i-1,Col].VertCellMerged := true;
         FWordTableCell[i-1,Col].NextMerCol := j;
         FWordTableCell[i,j].PrevMerCol := col;
         FWordTableCell[i,j].CellWidth := FWordTableCell[i-1,Col].CellWidth;
         Exit;
        end;
  end;

begin
{Эта часть для нахождения признаков вериткальной объединенности ячеек  существующей таблицы}
 for i := 1 to FMaxUsedRows do
  begin

   FWordTableCell[i,0].TableLeft:=0;
     for j := 1 to FMaxUsedCols do
     begin

      with FWordTableCell[i,j] do
      begin
       TableLeft := FWordTableCell[i,j - 1].TableLeft+
                     FWordTableCell[i,j - 1].CellWidth;

       FTableWidth := 0;
       for k := 1 to FMaxUsedCols do FTableWidth := FTableWidth + FWordTableCell[i-1, k].CellWidth;

       VertCellMerged := false;
       if Merged and not (FWordTableCell[i,j].TableLeft = FTableWidth) then

          CalcTableVertMergedInfo(i,j);
      end;
     end;
   end;

{Эта часть для нахождения характеристик вертикально объединенных ячеек}
   for j := 1 to FMaxUsedCols do

     for i := 1 to FMaxUsedRows do
      if FWordTableCell[i,j].VertCellMerged then

      begin
        N := 0;
        EndCol := j;
        while FWordTableCell[i + N, EndCol].NextMerCol <> -1 do
        begin

         EndCol := FWordTableCell[i + N, EndCol].NextMerCol;
         inc(N);
        end;
        FWordTableCell[i,j].EndMerRow := i + N;
        FWordTableCell[i,j].EndMerCol := EndCol;
      end;
{================================}
end;

Итак, заполнены все поля записи FWordTableCell для всех ячеек. Есть информация о каждой ячейке, которой можно воспользоваться, например, чтобы узнать содержимое любой ячейки.

Для демонстрации работы с массивом FWordTableCell воспользуемся компонентом TMStringGrid - аналогом компонента TStringGrid, но с возможностью объединения ячеек. Можно было бы использовать компонент TStringGrid, т.к. он работает гораздо быстрее TMStringGrid, или любой другой подходящий компонент, но так будет нагляднее.

Для объединения ячеек в таблице TMStringGrid предусмотрены функции с перегрузкой:

TMStringGrid.MergeCells(ALeft, ATop, ARight, ABottom : LongInt) : integer;

или

TMStringGrid. MergeCells(Selection : TMGridRect)  : integer;

где ALeft, ATop, ARight, ABottom - координаты левой верхней и правой нижней объединяемых ячеек таблицы TMStringGrid.

Однако, в массиве FWordTableCell эти координаты отсутствуют, и их нужно вычислить по данным массива FWordTableCell.

Для этой цели введем дополнительные типы (данные типы нужны исключительно для подготовки данных для компонента TMStringGrid):

TRowCell = record
    CellWidth : single;
    Index : integer;
    MergRect : TMGridRect;
    FirstMerRow : integer;
    FirstMerCol : integer;
    LastMerRow : integer;
    LastMerCol : integer;
    FirstMerg : boolean;
    Merged : boolean;
    Text : string;
  end;

  TGridCol = class(TCollectionItem)
  private
    RowCell : array of TRowCell;
  end;

  TGridCols = class(TCollection)
   FForm : TMainForm;
   function GetItem(Index : integer) : TGridCol;
  protected

   property Items[Index : integer] : TGridCol read GetItem;
   constructor Create(AOwner : TComponent);
   function Add : TGridCol;
  end;

а также, переменные и процедуры:

TMainForm = class(TForm)
...
  private
    { Private declarations }
...
    FGridCols : TGridCols;
    procedure WriteToGrid;
    procedure CalcGridProps;
...
  public

    { Public declarations }
  end;

Здесь процедура CalcGridProps заполняет массив RowCell коллекции TGridCol для каждой ячейки (также вычисляется действительное число колонок таблицы, т.к. FMaxUsedCols не является таковым):

procedure TMainForm.CalcGridProps;
var i,j,k : integer;
    RowCell : array of TRowCell;
    MinCellWidth : single;
    DeltaInd : array of integer;
    itBreak : boolean;

begin

 FGridCols.Clear;
 FGridCols.Add;
 SetLength(RowCell, FMaxUsedRows + 1);
 SetLength(DeltaInd, FMaxUsedRows + 1);

 for i := 1 to FMaxUsedRows do

 begin
  RowCell[i].CellWidth := FWordTableCell[i, 1].CellWidth;
  RowCell[i].Text := FWordTableCell[i, 1].Text;
  DeltaInd[i] := 0;
  RowCell[i].LastMerRow := FWordTableCell[i, 1].EndMerRow;
  if RowCell[i].LastMerRow = 0 then RowCell[i].LastMerRow := i;
  RowCell[i].FirstMerg := (FWordTableCell[i, 1].PrevMerCol = -1);
  RowCell[i].FirstMerCol := -1;
  RowCell[i].LastMerCol := -1;
 end;

 k := 0;
 repeat

  try
   MinCellWidth := RowCell[1].CellWidth;
   for i := 1 to FMaxUsedRows do

   begin
   if MinCellWidth <= 0 then break;
   if MinCellWidth > RowCell[i].CellWidth then

      MinCellWidth := RowCell[i].CellWidth;
   end;

  if MinCellWidth <= 0 then break;

   for i := 1 to FMaxUsedRows do

   if Abs(MinCellWidth - RowCell[i].CellWidth) < 0.1 then
      RowCell[i].CellWidth := MinCellWidth;


   FGridCols.Add;
   for i := 1 to FMaxUsedRows do

   begin

     with FGridCols.Items[k].RowCell[i] do
     begin
       CellWidth := MinCellWidth;
       Text := RowCell[i].Text;
       if RowCell[i].FirstMerg and (RowCell[i].LastMerRow <> i)and (RowCell[i].FirstMerCol = -1) then

       LastMerRow := RowCell[i].LastMerRow;
     end;

     if MinCellWidth < RowCell[i].CellWidth then
     begin
       FGridCols.Items[k + 1].RowCell[i].CellWidth :=  RowCell[i].CellWidth - MinCellWidth;
       if RowCell[i].FirstMerg and (RowCell[i].FirstMerCol = -1) then

         RowCell[i].FirstMerCol := k + 1;
       RowCell[i].LastMerCol := k + 2;
     end;
     if FGridCols.Items[k + 1].RowCell[i].CellWidth <> -1 then

     begin
      RowCell[i].CellWidth := FGridCols.Items[k + 1].RowCell[i].CellWidth;
      inc(DeltaInd[i]);
     end
     else
     begin
      if (RowCell[i].FirstMerCol <> -1) then

      begin
        FGridCols.Items[RowCell[i].FirstMerCol - 1].RowCell[i].LastMerCol := RowCell[i].LastMerCol;
        FGridCols.Items[RowCell[i].FirstMerCol - 1].RowCell[i].FirstMerCol := RowCell[i].FirstMerCol;
        FGridCols.Items[RowCell[i].FirstMerCol - 1].RowCell[i].LastMerRow := RowCell[i].LastMerRow;
        RowCell[i].LastMerCol := -1;
        RowCell[i].FirstMerCol := -1;
      end;
      RowCell[i].CellWidth := FWordTableCell[i, k + 2 - DeltaInd[i]].CellWidth;
      RowCell[i].FirstMerg := FWordTableCell[i, k + 2 - DeltaInd[i]].PrevMerCol = -1;
      RowCell[i].LastMerRow := FWordTableCell[i, k + 2 - DeltaInd[i]].EndMerRow;
      try

       RowCell[i].Text := FWordTableCell[i, k + 2 - DeltaInd[i]].Text;
      except
       RowCell[i].Text := '';
      end;
     end;
   end;
   inc(k);
  except

  end;
 until k > FMaxUsedCols + 50;

 for j := 0 to FGridCols.Count - 1 do

 for i := 1 to FMaxUsedRows do
 with FGridCols.Items[j].RowCell[i] do

 begin
  MergRect := GetMGridRect(j + 1, i, j + 1, i);
  if LastMerCol <> 0 then

  begin
   Merged := true;
   MergRect := GetMGridRect(FirstMerCol, i, LastMerCol, i);
  end;
  if LastMerRow <> 0 then
  begin

   Merged := true;
   MergRect := GetMGridRect(MergRect.Left, MergRect.Top, MergRect.Right, LastMerRow);
  end;
 end;
end;

Процедура WriteToGrid формирует копию таблицы Word в компоненте TMStringGrid:

procedure TMainForm.WriteToGrid;
var i, j, col : integer;
 Selection : TMGridRect;

begin

 MStringGrid1.ClearMergedCells;
 MStringGrid1.ColCount := FGridCols.Count - 1 ;
 MStringGrid1.RowCount := FMaxUsedRows;

 for j := 0 to FGridCols.Count - 1 do

 begin
   if j < MStringGrid1.ColCount then
   MStringGrid1.ColWidths[j] :=
   round(FGridCols.Items[j].RowCell[1].CellWidth);
   for i := 1 to FMaxUsedRows do

   begin
     if j < MStringGrid1.ColCount then
        MStringGrid1.Cells[j, i - 1] := FGridCols.Items[j].RowCell[i].Text;
   end;
 end;
 
 for j := 0 to FGridCols.Count - 1 do

 begin
   for i := 1 to FMaxUsedRows do
   begin

    if FGridCols.Items[j].RowCell[i].Merged then
     with FGridCols.Items[j].RowCell[i] do
     begin
      Selection.Left := MergRect.Left - 1;
      Selection.Top := MergRect.Top - 1;
      Selection.Right := MergRect.Right - 1;
      Selection.Bottom := MergRect.Bottom - 1;
      MStringGrid1.MergeCells(Selection);
      MStringGrid1.Cells[Selection.Left, Selection.Top] :=
      FGridCols.Items[j].RowCell[i].Text;
     end;
  end;
 end;

end;

Для демонстрации работы приведенного выше кода была создана программа DemoWordTable.exe (Рисунок 1).

Рисунок 1. Интерфейс программы

Нажав кнопку "Открыть таблицу Word", можно открыть документ Word, содержащий таблицу. Программа считывает первую таблицу и создает ее копию в компоненте TMStringGrid (Рисунок 2).

Рисунок 2. Таблица в Word (на заднем плане) и ее копия на форме MainForm

Кроме того, программа позволяет и обратное действие, т.е. создавать произвольную таблицу на форме и переносить ее в документ Word.

Для изменения числа строк и столбцов, а также фиксированных строк и столбцов предусмотрены поля Edit (После изменения значения в поле Edit нужно нажать "Enter", чтобы изменения вступили в силу). Чтобы объединить какие-либо ячейки, нужно сперва их выделить, удерживая клавишу Shift и нажимая клавиши со стрелками. Затем щелкнуть правой кнопкой мыши. Откроется Popup Menu с кнопками "Объединить ячейки" и "Разбить ячейки" (Рисунок 3.). Нажатие кнопки "Объединить ячейки" приведет к объединению ячеек выделенной области. Если выделения нет, т.е. выделена только одна ячейка, то кнопка "Объединить ячейки" открывает редактор ячеек (Рисунок 4). В редакторе можно выбрать нужные ячейки для объединения, ввести текст, который будет находиться в ячейке и выбрать положение текста в ячейке (TO_LEFT, TO_CENTER, TO_RIGHT).

Рисунок 3. Объединение ячеек

Рисунок 4. Объединение ячеек с помощью редактора

После создания таблицы можно нажать на кнопку "Записать таблицу Word", после чего будет создан новый документ Word, и таблица в нем, которая будет копией созданной таблицы (Рисунок 5).

Рисунок 5. Таблица на форме MainForm (на заднем плане) и ее копия в Word

Напоследок нужно сказать, что есть еще одна уловка при объединении ячеек таблицы Word: если заранее известны все номера ячеек, которые нужно объединить, то объединение нужно начать справа налево, снизу вверх. Тогда объединенные ячейки не спутают индексы ячеек, и все пройдет гладко:

procedure TMainForm.WriteToWordTable;

var WDoc : WordDocument;
    i, j, N : integer;
    Cl : Cell;
    MrgedCellInfo : TMrgedCellInfo;
begin
  WDoc := WApp.Documents.Add(EmptyParam, EmptyParam, EmptyParam, EmptyParam);//создаем документ
  WApp.Visible := true;
  FMaxUsedRows := MStringGrid1.RowCount;
  FMaxUsedCols := MStringGrid1.ColCount;
  FTable2 := WDoc.Tables.Add(WDoc.Content, FMaxUsedRows, FMaxUsedCols,
                                             EmptyParam, EmptyParam);     //создаем таблицу

  for i := 1 to 6 do SetBorders(FTable2, BorderType[i]);

  for i := MStringGrid1.ColCount - 1 downto 0 do

  for j := MStringGrid1.RowCount - 1 downto 0 do
  if MStringGrid1.GetMergedInfo(i, j, MrgedCellInfo) then

  begin
    if (i = MrgedCellInfo.MergedRect.Left) and (j = MrgedCellInfo.MergedRect.Top) then
    begin
     FTable2.Cell(j + 1, i + 1).Range.Text := MStringGrid1.Cells[i, j];
     Cl := FTable2.Cell(MrgedCellInfo.MergedRect.Bottom + 1, MrgedCellInfo.MergedRect.Right + 1);
     FTable2.Cell(j + 1, i + 1).Merge(Cl);
    end;
  end else

  FTable2.Cell(j + 1, i + 1).Range.Text := MStringGrid1.Cells[i, j];
 {====================================================================}
 //Копия таблицы создана.
end;

К сожалению, хотя данный метод и работает, но очень уж медленно из за неповоротливости редактора Word.

Ссылки по теме