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

Версия для печати

Работа с таблицами Word с объединенными ячейками
http://www.delphikingdom.com/asp/viewitem.asp?catalogID=1405
Дамир
дата публикации 19-07-2009 12:43
Работа с таблицами 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.
К статье прилагается пример:

DemoWordTable.zip