Дамир
дата публикации 19-07-2009 12:43

---

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

В статьях, посвященных работе с таблицами 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.