Форум: "Базы";
Текущий архив: 2004.08.29;
Скачать: [xml.tar.bz2];

Вниз

Импорт данных .txt, .dbf, .doc в Excel в Делфи 5-7   Найти похожие ветки 

← →
Diman   (2004-08-06 13:16) [0]

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

---

← →
Ega23 ©   (2004-08-06 13:20) [1]


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;

---

← →
Ega23 ©   (2004-08-06 13:21) [2]


   {записываем данные}
   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?

---

← →
Соловьев ©   (2004-08-06 13:24) [3]

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

---

← →
Nikolay M. ©   (2004-08-06 13:48) [4]

Data Transformation Service

---

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

dxDBGrid.SaveToXLS(FileName: string);

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

---

← →
Rule ©   (2004-08-06 14:15) [6]

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

---

← →
Ega23 ©   (2004-08-06 14:19) [7]

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

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

---

← →
}|{yk ©   (2004-08-06 14:50) [8]

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

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

---

← →
Diman   (2004-08-06 15:24) [9]

СПАСИБО !!!

---

Страницы: 1 вся ветка

Форум: "Базы";
Текущий архив: 2004.08.29;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.5 MB
Время: 0.044 c