| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Импорт данных .txt, .dbf, .doc в Excel в Делфи 5-7 [D6, MSSQL]

Diman ©   (2004-08-06 13:16:00) 

Как импортировать поля данных через BDE-Table(или что-то другое предложите) из других файлов(данные цифровые) в Excel ?
crystalsoft@rambler.ru

---

Diman   (2004-08-06 15:24:00) [1]

СПАСИБО !!!

---

}|{yk   (2004-08-06 14:50:00) [2]

Вобщем купи компоненты DevExpress, и будет тебе счастье

---
Ющенко - наш президент

---

Ega23   (2004-08-06 14:19:00) [3]

Ющенко - наш президент

А не пошёл бы ты в ...   "Потрепаться"?

---

Rule   (2004-08-06 14:15:00) [4]

}|{yk ©   (06.08.04 13:59) [5]
>Ющенко - наш президент
поддерживая (сори за оффтоп)

---

}|{yk   (2004-08-06 13:59:00) [5]

dxDBGrid.SaveToXLS(FileName: string);

---
Ющенко - наш президент

---

Nikolay M.   (2004-08-06 13:48:00) [6]

Data Transformation Service

---

Соловьев   (2004-08-06 13:24:00) [7]

http://www.delphikingdom.com/asp/viewitem.asp?catalogid=502

---

Ega23   (2004-08-06 13:21:00) [8]


   {записываем данные}
   ACol := 0;
   with aDbGrid.DataSource.DataSet do begin
     SaveBookmark := GetBookmark;
     DisableControls;
     First;
     //ShowWait(fRecordCount);
     while not Eof do begin
       for j := 0 to ACount - 1 do begin
         with WorkSheet.Ranges[ACol, ARow, ACol, ARow] do begin
           FillPattern := vtefpAutomatic;
           BackgroundFillPatternColor := clWhite;
           ForegroundFillPatternColor := clWhite;
           Font.Assign(aDbGrid.Columns[AColumns[j]].Font);
           WorkSheet.Ranges[ACol, ARow, ACol, ARow].Value := '';
           case aDbGrid.Columns[AColumns[j]].Field.DataType of
             ftString, ftFixedChar, ftWideString: begin
               WorkSheet.Ranges[ACol, ARow, ACol, ARow].Value := FieldByName(aDbGrid.Columns[AColumns[j]].Field.FieldName).AsString;
             end;
             ftSmallint, ftInteger, ftWord, ftAutoInc, ftLargeint: begin
               WorkSheet.Ranges[ACol, ARow, ACol, ARow].Value := FieldByName(aDbGrid.Columns[AColumns[j]].Field.FieldName).AsInteger;
             end;
             ftBoolean: begin
               WorkSheet.Ranges[ACol, ARow, ACol, ARow].Value := FieldByName(aDbGrid.Columns[AColumns[j]].Field.FieldName).AsBoolean;
             end;
             ftFloat: begin
               WorkSheet.Ranges[ACol, ARow, ACol, ARow].Value := FieldByName(aDbGrid.Columns[AColumns[j]].Field.FieldName).AsFloat;
             end;
             ftCurrency: begin
               WorkSheet.Ranges[ACol, ARow, ACol, ARow].Value := FieldByName(aDbGrid.Columns[AColumns[j]].Field.FieldName).AsCurrency;
             end;
             ftDate, ftTime, ftDateTime: begin
               WorkSheet.Ranges[ACol, ARow, ACol, ARow].Value := FieldByName(aDbGrid.Columns[AColumns[j]].Field.FieldName).AsDateTime;
             end;
           else
             WorkSheet.Ranges[ACol, ARow, ACol, ARow].Value := '';
           end;
           Borders[vtexlEdgeBottom].LineStyle := vtelsThin;
           Borders[vtexlEdgeBottom].Color := clBlack;
           Borders[vtexlEdgeLeft].LineStyle := vtelsThin;
           Borders[vtexlEdgeLeft].Color := clBlack;
           Borders[vtexlEdgeRight].LineStyle := vtelsThin;
           Borders[vtexlEdgeRight].Color := clBlack;
           Borders[vtexlEdgeTop].LineStyle := vtelsThin;
           Borders[vtexlEdgeTop].Color := clBlack;

           case aDbGrid.Columns[AColumns[j]].Alignment of
             taCenter:       HorizontalAlignment := vtexlHAlignCenter;
             taLeftJustify:  HorizontalAlignment := vtexlHAlignLeft;
             taRightJustify: HorizontalAlignment := vtexlHAlignRight;
           end;

         end;
         Inc(ACol);
       end;
       //StepWait;
       Next;
       ACol := 0;
       Inc(ARow);
     end;
     //HideWait;
     GotoBookMark(SaveBookmark);
     EnableControls;
   end;

   {записываем Footer}
   if aFooter<>'' then
   begin
    Inc(ARow);
     WorkSheet.Ranges[0, ARow, 100, ARow].FillPattern := vtefpAutomatic;
     WorkSheet.Ranges[0, ARow, 100, ARow].BackgroundFillPatternColor := clWhite;
     WorkSheet.Ranges[0, ARow, 100, ARow].ForegroundFillPatternColor := clWhite;
       with WorkSheet.Ranges[0, ARow, 0, ARow] do
       begin
         Value := aFooter;
         HorizontalAlignment := vtexlHAlignLeft;
       end;
       Inc(ARow);
     end;

    try lbColumnList.free;lbColumnList:=nil; except end;

   //сохранение
   Writer := TvteExcelWriter.Create;
   try
     Writer.Save(WorkBook, TheFileName);
     Writer.Free;
     result:=1;
   except
   //finally
     result:=-1;
     Writer.Free;
   end;
 finally
   WorkBook.Free;
 end;

 if result=-1 then
 begin
   mess:=replacestr(messFileCreateErr,'%THEFILE%', TheFileName);
   if aShowMessage then MessageBox(Application.Handle,PChar(mess), PChar('Внимание!'),MB_OK or MB_ICONWARNING);;
  exit;
 end;
 // открывать не надо, но хорошо бы сообщить
 if not aOpen then
 begin
    mess:=replacestr(messFileCreated,'%THEFILE%', TheFileName);
   if aShowMessage then MessageBox(Application.Handle,PChar(mess), PChar('Внимание!'),MB_OK or MB_ICONWARNING);;
  exit;
 end;

 //test TheFileName:=TheFileName+'123';
 // открытие
 try
  hnd:=ShellExecute(0, 'open', PChar(TheFileName), '', '',SW_SHOWMAXIMIZED ); //SW_SHOWNORMAL
  //FileExecuteWait(aFileName,'','',esNormal); не ЖДЕТ !!
  if hnd<=32 then result:=-2
             else result:=2;
 except
   result:=-2;
 end;

 if result=-2 then
 begin
    mess:=replacestr(messFileOpenErr,'%THEFILE%', TheFileName);
   if aShowMessage then MessageBox(Application.Handle,PChar(mess), PChar('Внимание!'),MB_OK or MB_ICONWARNING);
  exit;
 end;

end;

end.



З.Ы. А при чём тут MSSQL?

---

Ega23   (2004-08-06 13:20:00) [9]


unit UDBGridExport;

interface
uses
  BIFF8_Types, vteExcel, vteExcelTypes, vteWriters
 {$IFDEF BDE}, BDE{$ENDIF},
ShellAPI, Windows,
SysUtils, Classes, Graphics, Controls, Forms,
Grids, DBGrids, DB, StdCtrls, ClipBrd, Menus, DBTables,
Dialogs, strutils
// RxShell
 ;

Function SaveDBGridAsXLS(aDbGrid:tDBGrid; AFileName: shortstring='';
                         aHeader:shortString='';
                         aFooter:shortString='';
                         aSheetName: shortString='Sheet1';
                         ATitles: boolean=true;
                         aOpen: boolean=true;
                         aShowMessage: boolean=true;
                         aMaxLines:integer=-1
                         ):integer;

implementation

//-----------
Function SaveDBGridAsXLS(aDbGrid:tDBGrid; AFileName: shortstring='';
                         aHeader:shortString='';
                         aFooter:shortString='';
                         aSheetName: shortString='Sheet1';
                         ATitles: boolean=true;
                         aOpen: boolean=true;
                         aShowMessage: boolean=true;
                         aMaxLines:integer=-1
                         ):integer;
var i, j: integer;
   ACol, ARow: LongInt;
   SaveBookmark: TBookmark;
   WorkBook: TvteXLSWorkbook;
   WorkSheet: TvteXLSWorksheet;
   Writer: TvteCustomWriter;
   AColumns: variant;
   ACount: integer;
   lbColumnList:tStringList;
   mess,TheFileName,MSExcelName:string;
   hnd:thandle;
   DefFileNAme:string;
   xMArk:tbookmark;

(*
  result:=0 - нет данных в гриде
          1 - создан файл
         -1 - НЕ создан файл
          2 - создан файл и запущен Excel
         -2 - создан файл и НЕ запущен Excel
*)
const messNodata='Нет данных в таблице!';
     messFileBusy='Файл %THEFILE% занят приложением Microsoft Excel. Если открытая в нем информация полезна, сохраните ее в файл с другим именем !';
     messFileCreateErr='Ошибка создания файла. Возможно, файл %THEFILE% занят другим приложением';
     messFileCreated='Создан файла файл %THEFILE%. Если содержащаяся в нем информация полезна, сохраните его в файл с другим именем !';
     messFileOpenErr='Файл %THEFILE% успешно создан.'+CRLF+
                     'Не удается запустить приложение Microsoft Excel. ';
     messMaxLines='Таблица содержит %CNT% записей, операция может занять продолжительное время. '
                  +#$D+#$A
                  +'Выполнить операцию ?';

begin
result:=0; mess:='';
if aDbGrid=nil then mess:=messNodata;
if aDbGrid.DataSource=nil then mess:=messNodata;
if aDbGrid.DataSource.DataSet=nil then mess:=messNodata;
if aDbGrid.DataSource.DataSet.IsEmpty then mess:=messNodata;
if mess<>'' then
begin
 if aShowMessage then MessageBox(Application.Handle,PChar(mess), PChar('Внимание!'),MB_OK or MB_ICONWARNING);
 exit;
end;

 //Файл и не занят ли
   TheFileName:=trim(aFileNAme);
   if TheFileName='' then TheFileName:=extractFIlePath(paramstr(0))+'Export.xls';

   MSExcelName:='Microsoft Excel - '+ extractfilename(TheFileName);
   hnd := FindWindow(pchar('XLMAIN'), pchar(MSExcelName) );
   if hnd<>0 then
   begin
     result:=-1;
     mess:=replacestr(messFileBusy,'%THEFILE%', TheFileName);
      if aShowMessage then
      begin
       MessageBox(Application.Handle,PChar(mess), PChar('Внимание!'),MB_OK or MB_ICONWARNING);;
       BringWindowToTop(hnd);
      end;
    exit;
   end;

 // НЕ многовато ли строчек ????????
  i:=aDbGrid.DataSource.DataSet.recordcount;
  if i<0 then
  try
   xMArk:=aDbGrid.DataSource.DataSet.GetBookmark;
   aDbGrid.DataSource.DataSet.disablecontrols;
   aDbGrid.DataSource.DataSet.LAst;
   aDbGrid.DataSource.DataSet.GotoBookmark(xMArk);
   aDbGrid.DataSource.DataSet.FreeBookmark(xMArk);
   aDbGrid.DataSource.DataSet.enablecontrols;
   i:=aDbGrid.DataSource.DataSet.recordcount;
  except
   aDbGrid.DataSource.DataSet.enablecontrols;
  end;

  if aMaxLines<>-1 then
   if i>aMaxLines then
      if aShowMessage then
      begin
       result:=-1;
       mess:=replacestr(messMaxLines,'%CNT%', inttostr(i) );
       if IDCANCEL=MessageBox(Application.handle,PChar(mess),PChar('Внимание!'),MB_OKCANCEL or MB_ICONWARNING)
        then exit;
      end;

lbColumnList:=tStringList.Create;
ACount:=0;
AColumns := VarArrayCreate([0, aDbGrid.Columns.Count - 1], varSmallint);
with aDbGrid do
for i := 0 to Columns.Count - 1 do
 if (not ((Columns[i].Field.DataType = ftBytes)or (Columns[i].Field is TBlobField)))
     and (Columns[i].width>0)
  then lbColumnList.AddObject(Columns[i].Title.Caption, TObject(Columns[i]));

  with lbColumnList do
  begin
   for i := 0 to Count - 1 do
   begin
    AColumns[ACount] := TColumn(Objects[i]).Index;
    Inc(ACount);
   end;
 end;

 WorkBook := TvteXLSWorkbook.Create;
 try
   WorkBook.Clear;
   WorkSheet := WorkBook.AddSheet;
   if aSheetName <> '' then
     WorkSheet.Title := aSheetName
   else
     WorkSheet.Title := 'Sheet1';
   {передача данных в печатную форму}
   ARow := 0;
   {записываем Header}
   if aHeader<>'' then
   begin
     WorkSheet.Ranges[0, ARow, 100, ARow].FillPattern := vtefpAutomatic;
     WorkSheet.Ranges[0, ARow, 100, ARow].BackgroundFillPatternColor := clWhite;
     WorkSheet.Ranges[0, ARow, 100, ARow].ForegroundFillPatternColor := clWhite;
       with WorkSheet.Ranges[0, ARow, 0, ARow] do
       begin
         //Font.Color:=;
         Value := aHeader;
         HorizontalAlignment := vtexlHAlignLeft;
       end;
       Inc(ARow);
     end;

   {записываем шапку}
   if ATitles then begin
     ACol := 0;
     for j := 0 to ACount - 1 do begin
       with WorkSheet.Ranges[ACol, ARow, ACol, ARow] do begin
         FillPattern := vtefpAutomatic;
         BackgroundFillPatternColor := aDbGrid.FixedColor; //clWhite;
         ForegroundFillPatternColor := aDbGrid.FixedColor; //clWhite;
         Font.Assign(aDbGrid.Columns[AColumns[j]].Title.Font);
         Value := aDbGrid.Columns[AColumns[j]].Title.Caption;
         Borders[vtexlEdgeBottom].LineStyle := vtelsThin;
         Borders[vtexlEdgeBottom].Color := clBlack;
         Borders[vtexlEdgeLeft].LineStyle := vtelsThin;
         Borders[vtexlEdgeLeft].Color := clBlack;
         Borders[vtexlEdgeRight].LineStyle := vtelsThin;
         Borders[vtexlEdgeRight].Color := clBlack;
         Borders[vtexlEdgeTop].LineStyle := vtelsThin;
         Borders[vtexlEdgeTop].Color := clBlack;
         case aDbGrid.Columns[AColumns[j]].Title.Alignment of
           taCenter:       HorizontalAlignment := vtexlHAlignCenter;
           taLeftJustify:  HorizontalAlignment := vtexlHAlignLeft;
           taRightJustify: HorizontalAlignment := vtexlHAlignRight;
         end;
       end;
       WorkSheet.Cols[ACol].Width := aDbGrid.Columns[AColumns[j]].Width * 35;
       Inc(ACol);
     end;
     Inc(ARow);
   end;

---

Наверх