unit Unit1;interfaceuses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Grids, DBGrids, Db, DBTables, StdCtrls, Excel97, OleServer, ComObj, ActiveX, Excel2000;type TForm1 = class(TForm) Button1: TButton; Table1: TTable; DataSource1: TDataSource; DBGrid1: TDBGrid; ExcelApplication1: TExcelApplication; ExcelWorkbook1: TExcelWorkbook; ExcelWorksheet1: TExcelWorksheet; SaveDialog1: TSaveDialog; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private declarations } public { Public declarations } ExcelFormatNum: TStrings; //ExcelFormatNum ExcelFormatStr: TStrings; //ExcelFormatStr function ExportDBGrid(DBGrid: TDBGrid; SheetName: string): boolean;//直接保存,不顯示EXCEL function ExportDataToExcelV(SheetName: string; DBGrid: TDBGrid; ExcelApplication: TExcelApplication; ExcelWorkbook: TExcelWorkbook; ExcelWorksheet: TExcelWorksheet): boolean; //顯示EXCEL function ConvertIntToCharacters(IntNumber: Integer): string; function GetNumberFormat(s: string): string; //判斷字段的格式 function FindExcelFormatStr(s: string): Boolean; //找字符格式 function FindExcelFormatNum(s: string): Boolean; //找數字格式 end;var Form1: TForm1;implementation{$R *.DFM}function TForm1.ExportDataToExcelV(SheetName: string; DBGrid: TDBGrid; ExcelApplication: TExcelApplication; ExcelWorkbook: TExcelWorkbook; ExcelWorksheet: TExcelWorksheet): boolean; //顯示EXCEL //引用:ActiveX var Row, Col: integer; RowFirst, ColEnd: string; lcid: integer; vNumberFormat: string; begin result := false; if DBGrid.DataSource = nil then //數據源為空退出 exit; if DBGrid.DataSource.DataSet = nil then exit; if DBGrid.DataSource.DataSet.IsEmpty then exit; try ExcelApplication.Disconnect; except end; try try lcid := 1; //GetUserDefaultLCID; ExcelApplication.ScreenUpdating[lcid] := false; ExcelApplication.ConnectKind := ckNewInstance; ExcelApplication.Connect; except Application.MessageBox('系統檢測到此机器沒有安裝EXCEL!如果需要導出功能,先安裝EXCEL!','警告',MB_OK); exit; end; screen.Cursor := crHourGlass; ExcelWorkbook.ConnectTo(ExcelApplication.Workbooks.Add(TOleEnum(xlWBATWorksheet), lcid)); ExcelWorksheet.ConnectTo(ExcelWorkbook.Worksheets[1] as _Worksheet); if SheetName <> '' then ExcelWorksheet.Name := SheetName; ExcelWorksheet.Cells.Font.Size := 10; DBGrid.DataSource.DataSet.DisableControls; //導入報頭 for Col := 1 to DBGrid.Columns.Count do ExcelWorksheet.Cells.Item[1, Col].value := DBGrid.Columns[Col - 1].Title.caption; //導入數據庫 DBGrid.DataSource.DataSet.First; for Col := 1 to DBGrid.Columns.Count do begin RowFirst := ConvertIntToCharacters(Col) + '1'; //第一條 ColEnd := ConvertIntToCharacters(Col) + inttostr(DBGrid.DataSource.DataSet.RecordCount + 1);//結束 if DBGrid.Fields[Col - 1].DataSize < 200 then ExcelWorksheet.Range[RowFirst, ColEnd].ColumnWidth := DBGrid.Fields[Col - 1].DataSize else ExcelWorksheet.Range[RowFirst + '1', ColEnd].ColumnWidth := 21; vNumberFormat := GetNumberFormat(DBGrid.Columns[Col - 1].Title.Caption); if vNumberFormat <> '' then ExcelWorksheet.Range[RowFirst, ColEnd].NumberFormat := vNumberFormat; for Row := 1 to DBGrid.DataSource.DataSet.RecordCount do begin ExcelWorksheet.Cells.Item[Row + 1, Col].value := trim(DBGrid.Fields[Col - 1].AsString); DBGrid.DataSource.DataSet.Next; end; DBGrid.DataSource.DataSet.First; end; ExcelApplication.Visible[lcid] := True; ExcelApplication.ScreenUpdating[lcid] := true; DBGrid.DataSource.DataSet.EnableControls; result := true; finally screen.Cursor := crDefault; end; end;function TForm1.ConvertIntToCharacters(IntNumber: Integer): string; //IntNumber判斷字符串是否數字 begin if IntNumber < 1 then Result := 'A' else begin if IntNumber > 702 then Result := 'ZZ' else begin if IntNumber > 26 then begin if (IntNumber mod 26) = 0 then Result := Chr(64 + (IntNumber div 26) - 1) //返回 ASC 碼所代表的字符。 else Result := Chr(64 + (IntNumber div 26)); if (IntNumber mod 26) = 0 then result := result + chr(64 + 26) else result := Result + Chr(64 + (IntNumber mod 26)); end else Result := Chr(64 + IntNumber); end; end; end;function TForm1.GetNumberFormat(s: string): string; //判斷字段的格式 begin s := Uppercase(s); if FindExcelFormatNum(s) then begin result := '0.00'; Exit; end; if FindExcelFormatStr(s) then begin result := '@'; Exit; end; result := ''; end;function TForm1.FindExcelFormatStr(s: string): Boolean; //找字符格式 var i: integer; begin Result := False; for i := 0 to ExcelFormatStr.Count - 1 do begin if Pos(ExcelFormatStr[i], s) > 0 then begin Result := True; Exit; end; end; end;function TForm1.FindExcelFormatNum(s: string): Boolean; //找數字格式 var i: integer; begin Result := False; for i := 0 to ExcelFormatNum.Count - 1 do begin if Pos(ExcelFormatNum[i], s) > 0 then begin Result := True; Exit; end; end; end;function TForm1.ExportDBGrid(DBGrid: TDBGrid; SheetName: string): boolean;//直接保存,不顯示EXCEL //引用:ComObj var c, r, i, j: integer; app: Olevariant; TempFileName, ResultFileName: string; begin try result := True; app := CreateOLEObject('Excel.application'); app.WorkBooks.Add(xlWBatWorkSheet); except Application.MessageBox('Excel沒有正确安裝!','警告',MB_OK); result := False; exit; end; SaveDialog1.DefaultExt := 'xls'; SaveDialog1.FileName := SheetName; if SaveDialog1.Execute then TempFileName := SaveDialog1.FileName else Exit; app.Workbooks.add; app.Visible := false; Screen.Cursor := crHourGlass; DBGrid.DataSource.DataSet.First; c := DBGrid.DataSource.DataSet.FieldCount; r := DBGrid.DataSource.DataSet.RecordCount; Application.ProcessMessages; for i := 0 to c - 1 do app.cells(1, 1 + i) := DBGrid.DataSource.DataSet.Fields[i].DisplayLabel; for j := 1 to r do begin for i := 0 to c - 1 do app.cells(j + 1, 1 + i) := DBGrid.DataSource.DataSet.Fields[i].AsString; DBGrid.DataSource.DataSet.Next; end; ResultFileName := TempFileName; if ResultFileName = '' then ResultFileName := '自動報表'; if FileExists(TempFileName) then DeleteFile(TempFileName); app.Activeworkbook.saveas(TempFileName); app.Activeworkbook.close(false); app.quit; // app := unassigned; //對象釋放 //app:=nil; end;procedure TForm1.Button1Click(Sender: TObject); begin try Screen.Cursor := crHourGlass; //ExportDBGrid(DBGrid1, '查詢結果'); //直接保存,不顯示EXCEL ExportDataToExcelV('查詢結果', DBGrid1, ExcelApplication1, ExcelWorkbook1, ExcelWorksheet1); //顯示EXCEL finally Screen.Cursor := crDefault; end; end;procedure TForm1.FormCreate(Sender: TObject); begin Table1.Active:=true; ExcelFormatNum := TStringList.Create; ExcelFormatStr := TStringList.Create;
end; procedure TForm1.FormDestroy(Sender: TObject); begin ExcelFormatNum.Free; ExcelFormatStr.Free; end; end.
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Grids, DBGrids, Db, DBTables, StdCtrls, Excel97, OleServer, ComObj, ActiveX,
Excel2000;type
TForm1 = class(TForm)
Button1: TButton;
Table1: TTable;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
ExcelApplication1: TExcelApplication;
ExcelWorkbook1: TExcelWorkbook;
ExcelWorksheet1: TExcelWorksheet;
SaveDialog1: TSaveDialog;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
ExcelFormatNum: TStrings; //ExcelFormatNum
ExcelFormatStr: TStrings; //ExcelFormatStr
function ExportDBGrid(DBGrid: TDBGrid; SheetName: string): boolean;//直接保存,不顯示EXCEL
function ExportDataToExcelV(SheetName: string; DBGrid: TDBGrid; ExcelApplication: TExcelApplication;
ExcelWorkbook: TExcelWorkbook; ExcelWorksheet: TExcelWorksheet): boolean; //顯示EXCEL
function ConvertIntToCharacters(IntNumber: Integer): string;
function GetNumberFormat(s: string): string; //判斷字段的格式
function FindExcelFormatStr(s: string): Boolean; //找字符格式
function FindExcelFormatNum(s: string): Boolean; //找數字格式
end;var
Form1: TForm1;implementation{$R *.DFM}function TForm1.ExportDataToExcelV(SheetName: string; DBGrid: TDBGrid; ExcelApplication: TExcelApplication;
ExcelWorkbook: TExcelWorkbook; ExcelWorksheet: TExcelWorksheet): boolean; //顯示EXCEL
//引用:ActiveX
var
Row, Col: integer;
RowFirst, ColEnd: string;
lcid: integer;
vNumberFormat: string;
begin
result := false;
if DBGrid.DataSource = nil then //數據源為空退出
exit;
if DBGrid.DataSource.DataSet = nil then
exit;
if DBGrid.DataSource.DataSet.IsEmpty then
exit;
try
ExcelApplication.Disconnect;
except
end;
try
try
lcid := 1; //GetUserDefaultLCID;
ExcelApplication.ScreenUpdating[lcid] := false;
ExcelApplication.ConnectKind := ckNewInstance;
ExcelApplication.Connect;
except
Application.MessageBox('系統檢測到此机器沒有安裝EXCEL!如果需要導出功能,先安裝EXCEL!','警告',MB_OK);
exit;
end;
screen.Cursor := crHourGlass;
ExcelWorkbook.ConnectTo(ExcelApplication.Workbooks.Add(TOleEnum(xlWBATWorksheet), lcid));
ExcelWorksheet.ConnectTo(ExcelWorkbook.Worksheets[1] as _Worksheet);
if SheetName <> '' then
ExcelWorksheet.Name := SheetName;
ExcelWorksheet.Cells.Font.Size := 10; DBGrid.DataSource.DataSet.DisableControls;
//導入報頭
for Col := 1 to DBGrid.Columns.Count do
ExcelWorksheet.Cells.Item[1, Col].value := DBGrid.Columns[Col - 1].Title.caption; //導入數據庫
DBGrid.DataSource.DataSet.First;
for Col := 1 to DBGrid.Columns.Count do
begin
RowFirst := ConvertIntToCharacters(Col) + '1'; //第一條
ColEnd := ConvertIntToCharacters(Col) + inttostr(DBGrid.DataSource.DataSet.RecordCount + 1);//結束
if DBGrid.Fields[Col - 1].DataSize < 200 then
ExcelWorksheet.Range[RowFirst, ColEnd].ColumnWidth := DBGrid.Fields[Col - 1].DataSize
else
ExcelWorksheet.Range[RowFirst + '1', ColEnd].ColumnWidth := 21; vNumberFormat := GetNumberFormat(DBGrid.Columns[Col - 1].Title.Caption);
if vNumberFormat <> '' then
ExcelWorksheet.Range[RowFirst, ColEnd].NumberFormat := vNumberFormat; for Row := 1 to DBGrid.DataSource.DataSet.RecordCount do
begin
ExcelWorksheet.Cells.Item[Row + 1, Col].value := trim(DBGrid.Fields[Col - 1].AsString);
DBGrid.DataSource.DataSet.Next;
end;
DBGrid.DataSource.DataSet.First;
end;
ExcelApplication.Visible[lcid] := True;
ExcelApplication.ScreenUpdating[lcid] := true;
DBGrid.DataSource.DataSet.EnableControls;
result := true;
finally
screen.Cursor := crDefault;
end;
end;function TForm1.ConvertIntToCharacters(IntNumber: Integer): string;
//IntNumber判斷字符串是否數字
begin
if IntNumber < 1 then
Result := 'A'
else
begin
if IntNumber > 702 then
Result := 'ZZ'
else
begin
if IntNumber > 26 then
begin
if (IntNumber mod 26) = 0 then
Result := Chr(64 + (IntNumber div 26) - 1) //返回 ASC 碼所代表的字符。
else
Result := Chr(64 + (IntNumber div 26));
if (IntNumber mod 26) = 0 then
result := result + chr(64 + 26)
else
result := Result + Chr(64 + (IntNumber mod 26));
end
else
Result := Chr(64 + IntNumber);
end;
end;
end;function TForm1.GetNumberFormat(s: string): string; //判斷字段的格式
begin
s := Uppercase(s);
if FindExcelFormatNum(s) then
begin
result := '0.00';
Exit;
end; if FindExcelFormatStr(s) then
begin
result := '@';
Exit;
end;
result := '';
end;function TForm1.FindExcelFormatStr(s: string): Boolean; //找字符格式
var
i: integer;
begin
Result := False;
for i := 0 to ExcelFormatStr.Count - 1 do
begin
if Pos(ExcelFormatStr[i], s) > 0 then
begin
Result := True;
Exit;
end;
end;
end;function TForm1.FindExcelFormatNum(s: string): Boolean; //找數字格式
var
i: integer;
begin
Result := False;
for i := 0 to ExcelFormatNum.Count - 1 do
begin
if Pos(ExcelFormatNum[i], s) > 0 then
begin
Result := True;
Exit;
end;
end;
end;function TForm1.ExportDBGrid(DBGrid: TDBGrid; SheetName: string): boolean;//直接保存,不顯示EXCEL
//引用:ComObj
var
c, r, i, j: integer;
app: Olevariant;
TempFileName, ResultFileName: string;
begin
try
result := True;
app := CreateOLEObject('Excel.application');
app.WorkBooks.Add(xlWBatWorkSheet);
except
Application.MessageBox('Excel沒有正确安裝!','警告',MB_OK);
result := False;
exit;
end;
SaveDialog1.DefaultExt := 'xls';
SaveDialog1.FileName := SheetName;
if SaveDialog1.Execute then
TempFileName := SaveDialog1.FileName
else
Exit; app.Workbooks.add;
app.Visible := false;
Screen.Cursor := crHourGlass;
DBGrid.DataSource.DataSet.First;
c := DBGrid.DataSource.DataSet.FieldCount;
r := DBGrid.DataSource.DataSet.RecordCount;
Application.ProcessMessages;
for i := 0 to c - 1 do
app.cells(1, 1 + i) := DBGrid.DataSource.DataSet.Fields[i].DisplayLabel;
for j := 1 to r do
begin
for i := 0 to c - 1 do
app.cells(j + 1, 1 + i) := DBGrid.DataSource.DataSet.Fields[i].AsString; DBGrid.DataSource.DataSet.Next;
end; ResultFileName := TempFileName;
if ResultFileName = '' then
ResultFileName := '自動報表';
if FileExists(TempFileName) then
DeleteFile(TempFileName);
app.Activeworkbook.saveas(TempFileName);
app.Activeworkbook.close(false);
app.quit;
// app := unassigned; //對象釋放
//app:=nil;
end;procedure TForm1.Button1Click(Sender: TObject);
begin
try
Screen.Cursor := crHourGlass;
//ExportDBGrid(DBGrid1, '查詢結果'); //直接保存,不顯示EXCEL
ExportDataToExcelV('查詢結果', DBGrid1, ExcelApplication1, ExcelWorkbook1, ExcelWorksheet1); //顯示EXCEL
finally
Screen.Cursor := crDefault;
end;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
Table1.Active:=true;
ExcelFormatNum := TStringList.Create;
ExcelFormatStr := TStringList.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
ExcelFormatNum.Free;
ExcelFormatStr.Free;
end;
end.