1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
| unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, DB, ADODB, DBGrids, DBTables;
type
TForm1 = class(TForm)
Button1: TButton;
SaveDialog1: TSaveDialog;
DBGrid1: TDBGrid;
DataSource1: TDataSource;
Query1: TQuery;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
ComObj;
procedure TForm1.Button1Click(Sender: TObject);
const
wdAlignParagraphCenter = 1;
wdAlignParagraphLeft = 0;
wdAlignParagraphRight = 2;
wdLineStyleSingle = 1;
var
wdApp, wdDoc, wdRng, wdTable : Variant;
i, j, Res : Integer;
D : TDateTime;
Bm : TBookMark;
Sd : TSaveDialog;
begin
//{
Sd := SaveDialog1; //SaveDialog1 уже должен быть на форме.
//Если начальная папка диалога не задана, то в качестве начальной берём ту папку,
//в которой расположен исполняемый файл нашей программы.
if Sd.InitialDir = '' then Sd.InitialDir := ExtractFilePath( ParamStr(0) );
//Запуск диалога сохранения файла.
if not Sd.Execute then Exit;
//Если файл с заданным именем существует, то запускаем диалог с пользователем.
if FileExists(Sd.FileName) then begin
Res := MessageBox(0, 'Файл с заданным именем уже существует. Перезаписать?'
,'Внимание!', MB_YESNO + MB_ICONQUESTION + MB_APPLMODAL);
if Res <> IDYES then Exit;
end;
//Попытка запустить MS Word.
try
wdApp := CreateOleObject('Word.Application');
except
MessageBox(0, 'Не удалось запустить MS Word. Действие отменено.'
,'Внимание!', MB_OK + MB_ICONERROR + MB_APPLMODAL);
Exit;
end;
//Делаем видимым окно MS Word. На постоянной основе или на время отладки.
wdApp.Visible := True;
//Создаём новый документ.
wdDoc := wdApp.Documents.Add;
//На случай, если очень много данных и wdApp.Visible := True - тогда
//для ускорения работы отключаем перерисовку окна MS Word.
wdApp.ScreenUpdating := False;
try
wdRng := wdDoc.Content; //Диапазон, охватывающий всё содержимое документа.
//Параграф 1. Заголовок отчёта.
//Заголовок отчёта и перевод строки.
wdRng.InsertAfter('Отчёт'#13#10);
//Выравнивание по центру.
wdRng.ParagraphFormat.Alignment := wdAlignParagraphCenter;
//Параметры шрифта.
wdRng.Font.Name := 'Times New Roman';
wdRng.Font.Bold := True;
wdRng.Font.Size := 14;
//Параграф 2. Общие сведения.
//Формируем диапазон нового параграфа непосредственно за текущим диапазоном.
wdRng.Start := wdRng.End;
wdRng.InsertAfter(#13#10);
D := Now;
wdRng.InsertAfter('Дата: ' + FormatDateTime('dd.mm.yyyy', D) + #13#10);
wdRng.InsertAfter('Время: ' + FormatDateTime('hh:nn:ss:zzz', D) + #13#10);
//Сброс параметров параграфа.
wdRng.ParagraphFormat.Reset;
//Выравнивание по левому краю.
wdRng.ParagraphFormat.Alignment := wdAlignParagraphLeft;
//Отступ слева на 2 сантиметра. Размер отступа задаётся в типографских
//единицах - в пунктах. 1 пункт = 0.035 сантиметра.
//При записи в поле LeftIndent, отступ отсчитывается от левого поля на странице.
//wdRng.ParagraphFormat.LeftIndent := 2 / 0.035;
//Параметры шрифта.
wdRng.Font.Reset; //Сброс параметров шрифта.
wdRng.Font.Size := 12;
wdRng.Font.Bold := True;
//Параграф 3. Заголовок таблицы.
wdRng.Start := wdRng.End;
wdRng.InsertAfter(#13#10);
wdRng.InsertAfter('Таблица 1. Размер и население стран.'#13#10);
wdRng.ParagraphFormat.Reset;
wdRng.Font.Reset;
wdRng.Font.Size := 12;
wdRng.Font.Bold := False;
//Параграф 4. Таблица.
if not Query1.Active then Query1.Open;
wdRng.Start := wdRng.End;
//Добавляем таблицу MS Word. Пока создаём таблицу с двумя строками.
wdTable := wdDoc.Tables.Add(wdRng.Characters.Last, 2, Query1.Fields.Count);
//Параметры линий таблицы.
wdTable.Borders.InsideLineStyle := wdLineStyleSingle;
wdTable.Borders.OutsideLineStyle := wdLineStyleSingle;
//Сброс параметров параграфа.
wdRng.ParagraphFormat.Reset;
//Выравнивание всей таблицы - по левому краю.
wdRng.ParagraphFormat.Alignment := wdAlignParagraphLeft;
//Оформление шапки.
wdRng := wdTable.Rows.Item(1).Range; //Диапазон первой строки.
wdRng.ParagraphFormat.Alignment := wdAlignParagraphCenter;
wdRng.Font.Size := 10;
wdRng.Font.Bold := True;
//Оформление первой строки данных - это вторая строка в таблице.
//При добавлении следующих строк, их оформление будет копироваться с этой строки.
wdRng := wdTable.Rows.Item(2).Range; //Диапазон второй строки.
wdRng.ParagraphFormat.Alignment := wdAlignParagraphLeft;
wdRng.Font.Size := 10;
wdRng.Font.Bold := False;
//Записываем шапку таблицы.
for i := 0 to Query1.Fields.Count - 1 do
wdTable.Cell(1, i + 1).Range.Text := Query1.Fields[i].DisplayName;
//Записываем данные таблицы.
Query1.DisableControls;
Bm := Query1.GetBookMark;
Query1.First;
i := 1; //Текущая строка в таблице MS Word.
while not Query1.Eof do begin
Inc(i);
//Если требуется, добавляем новую строку в конец таблицы.
if i > 2 then wdTable.Rows.Add;
//Записываем данные в строку таблицы MS Word.
for j := 0 to Query1.Fields.Count - 1 do
wdTable.Cell(i, j + 1).Range.Text := Query1.Fields[j].AsString;
Query1.Next;
end;
Query1.GotoBookMark(Bm);
Query1.EnableControls;
finally
//Включение перерисовки окна MS Word. В случае, если wdApp.Visible := True.
wdApp.ScreenUpdating := True;
end;
wdApp.DisplayAlerts := False; //Отключаем режим показа предупреждений.
try
wdDoc.SaveAs(FileName:=Sd.FileName); //Запись документа в файл.
finally
wdApp.DisplayAlerts := True; //Включаем режим показа предупреждений.
end;
//Закрываем документ.
//wdDoc.Close;
//Закрываем MS Word.
//wdApp.Quit;
end;
end. |
(
Сообщение от Ieska
