Текущий архив: 2004.08.29;
Скачать: CL | DM;
Вниз
Импорт данных .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;
Скачать: CL | DM;
Память: 0.52 MB
Время: 0.028 c
