Оптимизация для Word

жекаизжека · #1 21.12.2008, 23:41

У меня есть код экспорта из dbgrid в excel, можете помочь переписать его под word

Код:

procedure TForm3.ToolButton3Click(Sender: TObject);
var
i,j,index: Integer;
ExcelApp,sheet,Colum: Variant;
begin
  ExcelApp := CreateOleObject('Excel.Application');
 ExcelApp.Visible := False;
 ExcelApp.WorkBooks.Add(-4167);
 ExcelApp.WorkBooks[1].WorkSheets[1].name := 'Учетная карточка';
 sheet:=ExcelApp.WorkBooks[1].WorkSheets['Учетная карточка'].Columns;
 Sheet.Cells[2,1]:='Учетная карточка '+Form1.Edit1.Text;
 Sheet.Range['A2','D2'].Font.Name:='Times New Roman';
 Sheet.Range['A2','D2'].Font.Bold:=true;
 Sheet.Range['A4','D4'].Font.Bold:=true;
 Sheet.Range['A2','D2'].Font.Size:=14;
 Sheet.Range['A2','D2'].Columns.WrapText:=false;
 Sheet.Range['A4']:='Дата';
 Sheet.Range['B4']:='Группа';
 Sheet.Range['C4']:='Тема';
 Sheet.Range['D4']:='Часы';
 Sheet.Range['A4','D4'].HorizontalAlignment:=xlHAlignCenter;

 Colum:=ExcelApp.Workbooks[1].WorkSheets['Учетная карточка'].Columns;
  Colum.Columns[1].ColumnWidth:=10;
 Colum.Columns[2].ColumnWidth:=10;
 Colum.Columns[3].ColumnWidth:=20;
 Colum.Columns[5].ColumnWidth:=20;

 index:=5; //Загоняем с первой строки
 DBGrid1.DataSource.DataSet.First;
      for i:=1 to  DBGrid1.DataSource.DataSet.RecordCount do
      begin
      for j:=1 to DBGrid1.FieldCount do
        sheet.cells[index,j]:=DBGrid1.fields[j-1].asstring;
      inc(index);
      DBGrid1.DataSource.DataSet.Next;
      end;
 ExcelApp.Visible := true;
end;

lmikle · #2 22.12.2008, 00:41

а тебе тоже надо в табличку?
Просто с табличкой там чуть посложнее. используется хитрый фокус с тем, сто при нажатии какой-то клавиши ворд сам добавляет строку.

А если без таблички, то смотри в ФАКе - примеров полно. Там практически тоже, что и с Экселем, но проще, т.к. нет листов.

жекаизжека · #3 22.12.2008, 01:27

в примере я видел, но там через запрос идет, что мне как раз и не надо, мне бы что бы в ворде была таблица такая же как и в DBGrid'e название столбцов и данные

жекаизжека · #4 22.12.2008, 01:53

Цитата:

Сообщение от lmikle

а тебе тоже надо в табличку?
Просто с табличкой там чуть посложнее. используется хитрый фокус с тем, сто при нажатии какой-то клавиши ворд сам добавляет строку.

А если без таблички, то смотри в ФАКе - примеров полно. Там практически тоже, что и с Экселем, но проще, т.к. нет листов.

Вот нашел, только как мне от запроса избавиться?

Код:

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.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;

и что тут по вашему лишнее?

жекаизжека · #5 24.12.2008, 01:17

ну народ помогите ((

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	RSS лента	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Новости сайта Новости форума	Ссылки и Баннеры Donate О сайте Реклама Контакты