Экспорт из БД в Word

К статье прилагаются исходный код примера и база данных . Выполнены в Delphi 7 и Access 2003 соответственно.

Статья написана на основе собственного опыта, и опыта других людей, полученного при общении в конференциях. И надеюсь, кому-нибудь хоть сколько поможет.
В статье приведены примеры работы с:
- таблицами;

- закладками;

- колонтитулами;

- надписями;

- шрифтами;

- курсором.

Не буду углубляться в особенности позднего и раннего связывания, т.к. информации на эту тему уже достаточно.
Итак, стоит задача экспортировать некую таблицу в Word. Даже не так, стоит задача сформировать сложный документ с колонтитулами таблицами заголовками и т.д., и т.п.
Есть два замечательных способа добывать информацию об интерфейсе Word:
- для того чтобы узнать, как что-то сделать из Delphi в Word-e надо в Word-е зайти в меню Сервис/Макрос/Начать запись... Потом сделать в Word-e то, что надо сделать из Delphi и закончить запись макроса. И наконец Сервис/Макрос/Макросы... выбираем записанный... Изменить и смотрим, как он устроен. После этого перевод синтаксиса VBA в синтаксис Delphi осуществляется просто и непринужденно;
- еще одним хорошим инструментом получения знаний являются компоненты типа TWordApplication. Кидаем его на форму, в любом операторе набираем WordApplication1., нажимаем "Сtrl + Пробел" и внимательно читаем. Смысл доступных функций и свойств обычно понятен интуитивно.
Есть, еще один, как мне сказали, наиболее логичный способ - справка VBA, но что-то не довелось мне ею пользоваться…
Теперь немного теории, добытой этими путями…

W1: TWordApplication;
Vr: OleVariant;

У W o d есть коллекция документов:

Vr := номер нужного документа;
 //так можно обратиться к нужному документу 
w1. Documents . Item ( vr ) ;

У всякой коллекции есть свойство count - количество таким образом w1.Documents.count - количество документов.
Использование переменной типа olevariant (в данном случае vr) иногда требуется, иногда нет.
У документа есть свои коллекции:

1. буквы (characters):

 // так можно получить доступ
// к коллекции букв активного документа 
w1. ActiveDocument . Characters 

Теперь можно получить доступ к:

w1. ActiveDocument . Characters . I tems ( vr ) … // конкретной букве 
w1. ActiveDocument . Characters . C ount … // количеству букв 

2. таблицы:

W1. activedocument . tables 

А вот так:

W1. ActiveDocument . Tables . Item (
 W1. ActiveDocument . Tables . Count ) . Columns . Item ( 2 ) . Select ;

можно выбрать вторую колонку последней таблицы.

3. абзацы:

w1. ActiveDocument . Paragraphs 

4. фигуры:

W1. ActiveDocument . Shapes 

Ну и т.д….
Еще есть полезные объекты selection - выбранная область и range - диапазон, а так-же функция select - выбрать. Выбрать можно таблицу, колонку (опять же W1.ActiveDocument.Tables.Item(W1.ActiveDocument.Tables.Count).Columns.Item(2).Select), букву, диапазон, абзац и т.д

Кстати, очень часто приходится работать с объектом range . Так, например, чтобы вытащить текст из документа, можно написать:

st:=w1. ActiveDocument . Range ( 1 , 5 ) . Text ;
 // Это будет текст с 1-го по 5-й символ 
st:=W1. ActiveDocument . Paragraphs . Item ( 1 ) . Range . Text ;
 // это будет текст первого абзаца текущего документа 

Теперь перейдем к конкретной реализации.
Пусть у нас есть база "Телефонный справочник", в которой есть следующие таблицы справочники:

Flat(IdFlat,NameFlat)
Korp(IdKorp,NameKorp)
Ul(IdUl,NameUl)

и дочерняя таблица Main (Id,Tel,Name,IdUl,House,IdKorp,IdFlat).

Почему структура именно такая - не важно… это - просто пример. Конкретная задача - экспортировать жильцов улиц Ахметова и Летчиков.
Причем выходной документ должен иметь титульную страницу, на которой пишется некий текст, со второй страницы идет верхний колонтитул, где тоже пишется некий текст. Далее существует два пути, как это реализовать.

1. Без использования шаблона.
Создается новый документ, где создаются колонтитулы надписи и т.д.
Этот путь использовать не стоит т.к. на разных компьютерах могут изначально стоять разные настройки страницы, шрифтов, абзацев и красиво сформированный документ у Вас на компьютере может ужасно выглядеть на другом. Можно, конечно, программно выставлять все необходимые настройки, но, во-первых, всего не учтешь, во-вторых это - большие тормоза и много кода.
2. С использованием шаблона.
Суть состоит в том, что заранее создается вордовский документ, который используется как шаблон. В нашем случае в шаблон в нужном месте в центре первой страницы ставим объект типа надпись, в котом выставляем нужный нам шрифт и выравнивание. Также делаем разрыв раздела. На второй странице в верхний колонтитул тоже вставляем объект надпись. В него мы будем вставлять название документа. Далее делаем макрос, в котором повторяем действия, которые нам нужно сделать из Делфи:
- в объект надпись на первой странице внести текст;
- перейти в конец документа;
- перейти в верхний колонтитул;
- в объект надпись в колонтитуле внести текст;
- вернуться на вторую страницу.

Получаем следующий макрос:

 Sub Макрос 1 () 
 ' 
 ' Макрос1 Макрос 
 ' Макрос записан 08.11.2004 YurikGL 
 ' 
 ActiveDocument. Shapes ( " Text Box 8 " ) . Select 
 Selection. TypeText Text:= " текст на титульной " 
 Selection. EndKey Unit:=wdStory
 If ActiveWindow. View . SplitSpecial <> wdPaneNone
 Then ActiveWindow. Panes ( 2 ) . Close 
 End If 
 If ActiveWindow. ActivePane . View . Type = wdNormalView 
 Or ActiveWindow.
 ActivePane. View . Type = wdOutlineView Then 
 ActiveWindow. ActivePane . View . Type = wdPrintView
 End If 
 ActiveWindow. ActivePane . View . SeekView = wdSeekCurrentPageHeader
 Selection. HeaderFooter . Shapes ( " Text Box 5 " ) . Select 
 Selection. TypeText Text:= " Текст в колонтитуле " 
 ActiveWindow. ActivePane . View . SeekView = wdSeekMainDocument
 End Sub 

Если преобразовать в код делфи, то получим:

 //выбираем первую надпись 
vr:= ' Text Box 8 ' ;
w1. ActiveDocument . Shapes . Item ( vr ) . Select ( EmptyParam ) ;
 //пишем туда текст 
w1. Selection . TypeText ( ' текст на титульной ' ) ;
 //переходим в конец документа 
vr:=wdStory;
w1. Selection . EndKey ( vr,EmptyParam ) ;
 {Всякие if-ы нам не нужны} 
 //переходим в верхний колонтитул 
w1. ActiveWindow . ActivePane . View . SeekView :=wdSeekCurrentPageHeader;
vr:= ' Text Box 5 ' ;
w1. Selection . HeaderFooter . Shapes . Item ( vr ) . Select ( EmptyParam ) ;
w1. Selection . TypeText ( ' текст в колонтитуле ' ) ;
w1. ActiveWindow . ActivePane . View . SeekView :=wdSeekMainDocument;

Итак, мы сформировали титульную страницу и колонтитул...

Кстати, кроме объектов "Надпись" можно еще эффективно использовать закладки. Чтобы узнать, как с ними работать, достаточно записать соответствующий макрос, а например, выбрать текст между первой и второй закладками можно так:

vr1,vr2,vr3,vr4:OleVariant;
vr1:= 1 ;
vr2:= 2 ;
vr3:=W1. ActiveDocument . Bookmarks . Item ( vr1 ) . End_ ;
vr4:=W1. ActiveDocument . Bookmarks . Item ( vr2 ) . End_ ;
W1. ActiveDocument . Range ( vr3,vr4 ) . Select ;

Кстати, если кто-нибудь найдет красивое решение без использования переменных OleVariant - отпишите мне на мыло.

Вывести данные из базы в документ можно либо используя слияние, либо построчно. Для слияния код выглядит примерно так:

 var 
 vr1,vr2,vr3,vr4,vr5,vr6: OleVariant;
 begin 
 vr1:= 0 ;
 vr2:= false ;
 vr3:= 'Provider=Microsoft.Jet.OLEDB.4.0;Password="""";
 User ID=Admin;
 Data Source=C:\Dataware\Deplhi7\Для статьи\db1.mdb;
 Mode=Read;Extended Properties="""";
 Jet OLEDB:System database="""";
 Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=5;' ;
 vr4:= 'SELECT Телефон, Корпус FROM QMain ORDER BY ФИО' ;
 vr5:= GetCurrentDir + ' \db1.mdb ' ;
 
 vr6:=- 1 ;
 winit;
 try 
 w1. Connect ;
 w1. Documents . Add ( EmptyParam,EmptyParam,EmptyParam,EmptyParam ) ;
 w1. Visible := true ;
 w1. Selection . Range . InsertDatabase ( vr1,vr1,vr2,
 vr3,vr4,EmptyParam,EmptyParam,EmptyParam,
 EmptyParam,EmptyParam,vr5,EmptyParam,
 EmptyParam,EmptyParam ) ;
 except 
 w1. Disconnect ;
 end ;

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

Для построчного вывода я пользовался созданной мною процедурой TableExport(DataSet:TDataSet; Title, FlagText:string), которая приведена в примере. В нее передаются датасет, заголовок таблицы и текстовый параметр FlagText. Если он равен ‘’ то экспортируется вся таблица. В противном случае, экспортируются лишь те записи, у которых значение последнего поля равно FlagText. Это сделано для того, чтобы получив выборку, которая долго вычислялась, можно было ее разнести по нескольким таблицам в отчете.
Заголовок, ширина столбца и отображать или не отображать поле задаются следующими параметрами поля:

 // заголовок 
ADODataSet1. fields [ 1 ] . DisplayLabel := 'ФИО' ;
 // ширина столбца 
ADODataSet1. fields [ 1 ] . tag := round ( w1. CentimetersToPoints ( 10 )) ;
 // отображать поле 
ADODataSet1. fields [ 1 ] . Visible := true ;

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

 // проведение границы с левой стороны выбранной области
// Используется при формировании таблиц.
 // Изменяя параметры, можно создавать произвольные таблицы 
w1. Selection . Cells . Borders . Item ( wdBorderLeft ) . 
 LineStyle :=wdLineStyleSingle; 
 //изменение параметров шрифта 
 W1. Selection . Font . Size := 15 ;
 //изменение параметров шрифта 
W1. Selection . Font . bold := 1 ; 
 // получить номер последнего символа выбранной
 // области 
I:= W1. Selection . End ;

Если Вы работаете через OleContainer, то нелишними будут команды типа:

OleContainer1. OleObject . CommandBars . Item [ 
 'Standard' ] . Visible := false ;
OleContainer1. OleObject . CommandBars . Item [
 'Formatting' ] . Visible := false ;
OleContainer1. OleObject . CommandBars . Item [
 'Drawing' ] . Visible := false ;

которые убирают соответствующие менюшки, которые обычно разлетаются по всей форме.
Если работать через CreateOleObject, то чтобы получить значение констант VisualBasic, которые Дельфи вообще говоря не понимает, надо внутри макроса написать MsgBox(нужная_константа). Тогда он покажет ее численное значение, их-то в Дельфи и использовать.
Теперь привожу код всей программы:

 unit Unit1;
 
 interface 
 
 uses 
 Windows, Messages, SysUtils, Variants, Classes,
 Graphics, Controls, Forms, Dialogs, StdCtrls,
 DB, ADODB, OleServer, W ord2000;
 
 type 
 TForm1 = class ( TForm ) 
 ADOConnection1: TADOConnection;
 ADODataSet1: TADODataSet;
 Button1: TButton;
 W1: TWordApplication;
 
 // Здесь удалено несколько строчек 
 
 StatusLabel: TLabel;
 Button2: TButton;
 Button3: TButton;
 procedure Button1Click ( Sender: TObject ) ;
 procedure TableExport ( DataSet:TDataSet;
 Title, FlagText: string ) ;
 Procedure TableLineSet;
 procedure WInit;
 procedure Button2Click ( Sender: TObject ) ;
 private
 { Private declarations } 
 public
 { Public declarations } 
 end ;
 
 var 
 Form1: TForm1;
 
 implementation 
 
 uses ComObj;
 
 {$R *.dfm} 
 
 procedure TForm1. Button1Click ( Sender: TObject ) ;
 var 
 vr: olevariant;
 begin 
 try 
 statusLabel. Caption := 'Формирую отчет ждите' ;
 winit;
 w1. Connect ;
 //w1.Visible:=true; 
 vr:= GetCurrentDir + ' \Shablon.doc' ;
 W1. Documents . Open ( vr,EmptyParam,EmptyParam,
 EmptyParam,EmptyParam,EmptyParam,
 EmptyParam,EmptyParam,EmptyParam,
 EmptyParam,EmptyParam,EmptyParam ) ;
 //выбираем первую надпись 
 vr:= 'Text Box 8' ;
 w1. ActiveDocument . Shapes . Item ( vr ) . Select ( EmptyParam ) ;
 //пишем туда текст 
 w1. Selection . TypeText ( 'текст на титульной' ) ;
 //переходим в конец документа 
 vr:=wdStory;
 w1. Selection . EndKey ( vr,EmptyParam ) ;
 {Всякие if-ы нам не нужны} 
 //переходим в верхний колонтитул 
 w1. ActiveWindow . ActivePane . View . SeekView :=
 wdSeekCurrentPageHeader;
 vr:= 'Text Box 5' ;
 w1. Selection . HeaderFooter . Shapes . Item ( vr ) . Select ( EmptyParam ) ;
 w1. Selection . TypeText ( 'текст в колонтитуле' ) ;
 w1. ActiveWindow . ActivePane . View . SeekView :=wdSeekMainDocument;
 ADODataSet1. Close ;
 ADODataSet1. CommandText := 
 'SELECT [Main].[Tel], ' +
 '[Main].[name], ' +
 '[Main].[House], ' +
 '[Korp].[NameKorp], ' +
 '[Flat].[NameFlat], ' +
 '[Ul].[NameUl] ' +
 ' FROM Main, Ul, Korp, Flat ' +
 ' WHERE ([Main].[IdUl]=[Ul].[IdUl])
 And ([Main].[IdKorp]=[Korp].[IdKorp])
 And ([Main].[IdFlat]=[Flat].[IdFlat]) ' ;
 ADODataSet1. Open ;
 // несколько строчек убрано 
 // настраиваем параметры экспорта
 // заголовок 
 ADODataSet1. fields [ 0 ] . DisplayLabel := 'Телефон' ; 
 //ширина столбца 
 ADODataSet1. fields [ 0 ] . tag := round ( w1. CentimetersToPoints ( 2 )) ;
 //отображать поле 
 ADODataSet1. fields [ 0 ] . Visible := true ;
 //заголовок 
 ADODataSet1. fields [ 1 ] . DisplayLabel := 'ФИО' ; 
 //ширина столбца 
 ADODataSet1. fields [ 1 ] . tag := round ( w1. CentimetersToPoints ( 10 )) ;
 ADODataSet1. fields [ 1 ] . Visible := true ;
 ADODataSet1. fields [ 2 ] . DisplayLabel := 'Дом' ; 
 //ширина столбца 
 ADODataSet1. fields [ 2 ] . tag := round ( w1. CentimetersToPoints ( 1 . 5 )) ;
 ADODataSet1. fields [ 2 ] . Visible := true ;
 ADODataSet1. fields [ 3 ] . DisplayLabel := 'Корпус' ; 
 //ширина столбца 
 ADODataSet1. fields [ 3 ] . tag := round ( w1. CentimetersToPoints ( 1 . 5 )) ;
 ADODataSet1. fields [ 3 ] . Visible := true ;
 ADODataSet1. fields [ 4 ] . DisplayLabel := 'Квартира' ; 
 //ширина столбца 
 ADODataSet1. fields [ 4 ] . tag := ound ( w1. CentimetersToPoints ( 1 . 5 )) ;
 //отображать поле 
 ADODataSet1. fields [ 4 ] . Visible := true ;
 //не отображать поле 
 ADODataSet1. fields [ 5 ] . Visible := false ;
 //вызываем процедуру экспорта 
 TableExport ( ADODataSet1, ' Живущие на улице
 Ахметова' , 'АХМЕТОВА' ) ;
 TableExport ( ADODataSet1, 'Живущие на улице
 Летчиков' , 'ЛЕТЧИКОВ' ) ;
 //отображем Word. Это можно было сделать и
 // вначале, но тогда вывод данных был бы
 // значительно медленнее 
 w1. Visible := true ;
 w1. Disconnect ;
 statusLabel. Caption := '' ;
 except 
 on e:exception do begin 
 w1. Visible := true ;
 statusLabel. Caption := 'Отчет был сформирован неверно' ;
 w1. Disconnect ;
 raise Exception. Create ( 'Ошибка формирования
 отчета.' + #13 +e. Message ) ;
 end ;
 end ;
 end ;
 
 procedure TForm1. TableExport ( DataSet:TDataSet;
 Title, FlagText: string ) ;
 var 
 i,ColCount, // количество колонок в таблице 
 TableBeg, // Номер символа в начале таблицы 
 TableBeg2: integer ; // Номер символа в начале данных таблицы 
 vr1,vr2:OleVariant;
 f: boolean ;
 st: string ;
 
 Function ConvertString ( S: string ) : string ;
 {это, казалось бы глупая функция, делает очень
важное дело.
При формировании таблицы в качестве разделителя по
умолчанию
используется "-", который может встречаться в
экспортируемых
записях. В этом случае в таблицу преобразуется
абсолютно
неверно. Чтобы избежать этого, мы меняем обычный 
"-" на символ
с кодом #173, который отображается точно так-же} 
 Begin 
 Result := StringReplace ( S, '-' , #173 , []) ;
 End ;
 Begin 
 {Процедура экспортирует лишь те записи датасета,
 у которых
значение последнего поля совпадает с FlagText
Если FlagText='' то экспортируются все записи.
Это связано с тем, что зачастую нужно разнести
в разные таблицы записи, полученные в результате
долго выполняемого запроса} 
 
 Application. ProcessMessages ;
 vr1:=wdStory;
 //переходим в конец документа 
 w1. Selection . EndKey ( vr1,EmptyParam ) ; 
 //вставляем заголовок таблицы 
 W1. ActiveDocument . Range ( EmptyParam,EmptyParam ) . 
 InsertAfter ( Title ) ;
 // далее идут настройки, что-бы заголовок не
 // отрывался от основной таблицы и все красиво выглядело 
 W1. ActiveDocument . Paragraphs . Item ( w1. 
 ActiveDocument . Paragraphs . Count ) . Range . Select ;
 W1. Selection . ParagraphFormat . KeepWithNext :=- 1 ;
 W1. Selection . ParagraphFormat . SpaceAfter := 14 ;
 W1. Selection . Font . Size := 15 ; //применяем шрифт 
 W1. Selection . Font . bold := 1 ;
 //добавляем строчку 
 //выбираем ее 
 W1. ActiveDocument . Paragraphs . Add ( EmptyParam ) ;
 W1. ActiveDocument . Paragraphs . Item ( w1. 
 ActiveDocument . Paragraphs . Count ) . Range . Select ;
 W1. Selection . ParagraphFormat . SpaceAfter := 0 ;
 vr1:=wdStory; 
 //переходим в конец документа 
 w1. Selection . EndKey ( vr1,EmptyParam ) ;
 // запоминаем положение курсора. Это - начало
 // будущей таблицы. 
 // потом выберем весь оставшийся текст, чтобы
 // преобразовать его в таблицу 
 // В ворде есть такая фунция "Преобразовать в
 // таблицу" ею и воспользуемся 
 TableBeg:=W1. Selection . End_ ;
 DataSet. First ;
 //вставляем заголовки для всех видимых полей 
 for i:= 0 to DataSet. FieldCount - 1 do 
 if DataSet. Fields [ i ] . Visible then 
 W1. ActiveDocument . Range ( EmptyParam,EmptyParam ) . 
 InsertAfter ( convertstring ( DataSet. Fields [ i ] . 
 DisplayLabel ) + #9 ) ;
 Application. ProcessMessages ;
 w1. Selection . EndKey ( vr1,EmptyParam ) ;
 //убираем последний символ табуляции 
 {Вообще символ табуляции используется в качестве
 разделителя для столбцов таблиццы} 
 w1. Selection . TypeBackspace ;
 //применяем шрифт 
 W1. ActiveDocument . Paragraphs . Item ( w1. 
 ActiveDocument . Paragraphs . Count ) . Range . Select ;
 W1. Selection . Font . Size := 14 ;
 W1. Selection . Font . Italic := 1 ;
 W1. Selection . Font . bold := 0 ;
 
 //добавляем строчку 
 W1. ActiveDocument . Paragraphs . Add ( EmptyParam ) ;
 // флаг для определения, были ли в таблице вообще
 // записи
 // для экспорта 
 f:= true ;
 // в эту строчку будем экспортировать текст
 // таблицы 
 st:= '' ;
 TableBeg2:=W1. Selection . End_ ; //начало данных в таблице 
 
 if dataset. RecordCount > 0 then begin 
 Repeat 
 Application. ProcessMessages ;
 if ( dataset. fields [ DataSet. Fields . Count - 1 ] . 
 AsString =FlagText ) or ( FlagText= '' ) 
 then begin 
 // через табуляцию выводим все видимые поля 
 for i:= 0 to DataSet. FieldCount - 1 do 
 if DataSet. Fields [ i ] . Visible
 then st:=st+DataSet. Fields [ i ] . AsString + #9 ;
 // убираем последний символ табуляции 
 SetLength ( st, length ( st ) - 1 ) ; 
 st:=st+ #13 ; // перенос строки 
 f:= false ;
 end ;
 dataset. Next ;
 until dataset. Eof ; 
 //уходим в конец текста 
 w1. Selection . EndKey ( vr1,EmptyParam ) ; 
 //вставляем данные таблицы 
 W1. Selection . InsertAfter ( convertstring ( st )) ;
 vr1:=TableBeg2; / /начало данных таблицы 
 vr2:=W1. Selection . End_ ; / /конец таблицы 
 W1. ActiveDocument . Range ( vr1,vr2 ) . Select ;
 W1. Selection . Font . Size := 12 ;
 W1. Selection . Font . bold := 0 ;
 W1. Selection . Font . Italic := 0 ;
 end ;
 //в том случае, если не экспортировалось ни одной
 // записи формируем пустую строчку 
 if f then begin 
 for i:= 0 to DataSet. FieldCount - 1 do 
 if DataSet. Fields [ i ] . Visible then 
 W1. ActiveDocument . Range ( EmptyParam,
 EmptyParam ) . InsertAfter ( ' ' + #9 ) ;
 w1. Selection . EndKey ( vr1,EmptyParam ) ;
 w1. Selection . TypeBackspace ;
 end ;
 Application. ProcessMessages ;
 vr1:=TableBeg; //начало будущей таблицы 
 vr2:=W1. Selection . End_ ; //конец будущей таблицы 
 //выбираем этот диапазон 
 W1. ActiveDocument . Range ( vr1,vr2 ) . Select ;
 //и преобразуем его в таблицу 
 W1. Selection . ConvertToTable ( EmptyParam,
 EmptyParam,
 EmptyParam,EmptyParam,EmptyParam,EmptyParam,
 EmptyParam,EmptyParam,EmptyParam,EmptyParam,
 EmptyParam,EmptyParam,EmptyParam,EmptyParam,
 EmptyParam,EmptyParam ) ;
 colcount:= 1 ;
 //выставляем ширины колонок 
 for i:= 0 to DataSet. FieldCount - 1 do 
 if DataSet. Fields [ i ] . Visible then begin 
 W1. ActiveDocument . Tables . Item ( W1. 
 ActiveDocument . Tables . 
 Count ) . Columns . Item ( colcount ) . Width :=
 DataSet. Fields [ i ] . Tag ;
 inc ( colcount ) ;
 Application. ProcessMessages ;
 end ;
 
 TableLineSet;
 // эта процедура прорисовывает нужные
 // границы таблицы 
 W1. ActiveDocument . Paragraphs . Add ( EmptyParam ) ;
 W1. ActiveDocument . Paragraphs . Item ( w1. 
 ActiveDocument . Paragraphs . Count - 1 ) . Range . Select ;
 W1. Selection . ParagraphFormat . KeepWithNext := 0 ;
 End ;
 
 // эта процедура прорисовывает нужные границы таблицы 
 Procedure TForm1. TableLineSet ; 
 Begin 
 w1. Selection . Cells . Borders . Item ( wdBorderLeft ) . 
 LineStyle :=wdLineStyleSingle;
 w1. Selection . Cells . Borders . Item ( wdBorderRight ) . 
 LineStyle :=wdLineStyleSingle;
 w1. Selection . Cells . Borders . Item 
 ( wdBorderHorizontal ) . LineStyle :=wdLineStyleSingle;
 w1. Selection . Cells . Borders . Item ( wdBorderTop ) . 
 LineStyle :=wdLineStyleSingle;
 w1. Selection . Cells . Borders . Item ( wdBorderBottom ) . 
 LineStyle :=wdLineStyleSingle;
 w1. Selection . Cells . Borders . Item 
 ( wdBorderVertical ) . LineStyle :=wdLineStyleSingle;
 End ;
 
 procedure TForm1. WInit ;
 Begin 
 // для избежания глюков полезно убивать
 // используемые компоненты 
 // и потом их создавать заново... 
 W1. free ;
 W1:=TWordApplication. Create ( Form1 ) ; 
 //Чтобы всегда новое приложение запускалось 
 w1. connectkind :=ckNewInstance;
 End ;
 
 procedure TForm1. Button2Click ( Sender: TObject ) ;
 var 
 vr1,vr2,vr3,vr4,vr5:OleVariant;
 begin 
 vr1:= 0 ;
 vr2:= false ;
 vr3:= 'Provider=Microsoft.Jet.OLEDB.4.0;
 Password="""";
 User ID=Admin;Data
 Source=C:\Dataware\Deplhi7\Для статьи\db1.mdb;
 Mode=Read;Extended Properties="""";
 Jet OLEDB:System database="""";
 Jet OLEDB:Database Password="""";
 Jet OLEDB:Engine Type=5;' ;
 vr4:= 'SELECT Телефон, Корпус FROM QMain ORDER BY ФИО' ;
 vr5:= GetCurrentDir + ' \db1.mdb ' ;
 winit;
 try 
 w1. Connect ;
 w1. Documents . Add ( EmptyParam,EmptyParam,
 EmptyParam,EmptyParam ) ;
 w1. Visible := true ;
 w1. Selection . Range . InsertDatabase ( vr1,vr1,vr2,
 vr3,vr4,EmptyParam,EmptyParam,EmptyParam,
 EmptyParam,EmptyParam,vr5,EmptyParam,
 EmptyParam,EmptyParam ) ;
 except 
 w1. Disconnect ;
 end ;
 end ;
 
 end .

Скачать исходник (74 Кб)