用 OLE 把 DBGrid 内容输出到Excel - bestlong 怕失憶論壇

procedure DBGridToExcel(ADBGrid: TDBGrid);
const
xlWBatWorkSheet = -4167;
var
iCol, iRow: Integer;
sCell: string;
ExcelApp, Sheet: OleVariant;
function GetColA2Z(Col: Integer):string; //欄位超過 Z 怎麼辦? 這裡幫你算啦～
begin
if (Col mod 26 = 0) then
Result := 'Z'
else
Result := Chr((Col mod 26)+64);
//遞迴, 就算你 ZZZ 我也幫你算
if Col > 26 then
Result := GetColA2Z(Col div 26) + Result;
end;
begin
try
try
ExcelApp := CreateOleObject('Excel.Application');
ExcelApp.Visible := False;
except
ShowMessage('連結 Excel 錯誤');
Exit;
end;
ExcelApp.WorkBooks.Add(xlWBatWorkSheet);
Sheet := ExcelApp.WorkBooks[1].WorkSheets[1];
//輸出標題
iRow := 1;
for iCol := 0 to ADBGrid.FieldCount - 1 do
begin
sCell := GetColA2Z(iCol+1) + IntToStr(iRow);
Sheet.Cells.Range[sCell, sCell].NumberFormatLocal := '@'; //標題都設為文字格式
Sheet.Cells.Range[sCell, sCell].Value := ADBGrid.Columns.Items[iCol].Title.Caption;
// Sheet.Cells[1, iCol + 1].Value := ADBGrid.Columns.Items[iCol].Title.Caption;
end;
//輸出資料
iRow := 2;
ADBGrid.DataSource.DataSet.DisableControls;
ADBGrid.DataSource.DataSet.First;
while not ADBGrid.DataSource.DataSet.Eof do
begin
for iCol := 0 to ADBGrid.FieldCount -1 do
begin
sCell := GetColA2Z(iCol+1) + IntToStr(iRow);
if ADBGrid.Fields[iCol].DataType in [ftString, ftMemo, ftWideString] then
begin
Sheet.Cells.Range[sCell, sCell].NumberFormatLocal := '@';
end;
Sheet.Cells.Range[sCell, sCell].Value := ADBGrid.Fields[iCol].AsString;
// Sheet.Cells[iRow, iCol + 1].Value := ADBGrid.Fields[iCol].AsString;
end;
ADBGrid.DataSource.DataSet.Next;
Inc(iRow);
end;
ExcelApp.Visible := True;
finally
ADBGrid.DataSource.DataSet.EnableControls;
if not VarIsEmpty(ExcelApp) then
begin
Sheet := Unassigned;
ExcelApp := Unassigned;
end;
end;
end;

複製代碼

// 因為工作上使用到的, 幫部門寫的小程式經常要輸出 Excel
// 所以寫個元件來簡化
//
// 功能：
// 1. DBGrid 或 StringGrid 上按下右鍵後可以選擇 [輸出到 Excel]
// 2. 自動生成 PopupMenu / MenuItem, 並整合入自訂的 PopupMenu, 不必額外煩惱操作介面
// 3. DBGrid 可使用按下 Title 後做 Sort 的功能 (但 DBGrid 的 DataSet 要是 SQL Query, 且不能太複雜)
// 4. 在執行時期若要關閉, 不允許 user 轉出資料, 只要將特定 Grid 的 forbidden := nil 即可
// 要再打開, 只要重新 Initial 即可
//
// 使用：
// 0. 將元件拉放到 Form 上
// 1. 在 FormCreate 中加入
// GridExport.Initial(Self);
// 即可自動使用, 額外有預設為 False 的參數 aTitleSort: boolean
// 2. 在 FormClose 中加入
// GridExport.FreeAll;
// 確保 [自有物件] 及 Excel 正確 Free
// 3. 程式執行時, 於 DBGrid / StringGrid 上按右鍵跳出 PopupMenu,
// 其中 MenuItem 會自動跟你指定給 Grid 的 PopupMenu 結合
// 4. 執行 Export to Excel, 從 DBGrid / StringGrid 將資料匯出到 Excel
//
// 附帶函式四個
// A. 自動設定 String Grid 的第 aCol 個 column width
// B. 應用 A 來做多個 column 的自動調整
// C. "自訂 DBGrid 的文字外觀時, 放在 OnDrawColumnCell 的最後來使用"
// D. "自訂 StringGrid 的文字外觀時, 放在 OnDrawCell 的最後來使用"

總是看網站上很多人問 DB to Excel 的問題
所以也上來現個醜
其實我只用很簡單的想法和oo觀念而已
原先在另一 Delphi 討論站有發表過舊的版本(太久沒去都忘了站名)
而來到 KTop 又發現一些新東西就再加進去
(例如 DBGrid 文字外觀的 Alignment)
使用很久了, 從 D6 ~ D7 都沒問題
又很簡單
只要丟著再加兩行程式就好了
有興趣看看 Suorce 吧
有覺得不夠精簡的地方非常歡迎來信
想自行擴充也沒關係, 沒有任何限制
只希望改完也來把好主意與大家分享

另: 公司網路慢, 沒有仔細爬, 若站上已有類似的元件請勿見怪

{1. With OLE Automation }
uses
ComObj;
function RefToCell(ARow, ACol: Integer): string;
begin
Result := Chr(Ord('A') + ACol - 1) + IntToStr(ARow);
end;
function SaveAsExcelFile(AGrid: TStringGrid; ASheetName, AFileName: string): Boolean;
const
xlWBATWorksheet = -4167;
var
Row, Col: Integer;
GridPrevFile: string;
XLApp, Sheet, Data: OLEVariant;
i, j: Integer;
begin
// Prepare Data
Data := VarArrayCreate([1, AGrid.RowCount, 1, AGrid.ColCount], varVariant);
for i := 0 to AGrid.ColCount - 1 do
for j := 0 to AGrid.RowCount - 1 do
Data[j + 1, i + 1] := AGrid.Cells[i, j];
// Create Excel-OLE Object
Result := False;
XLApp := CreateOleObject('Excel.Application');
try
// Hide Excel
XLApp.Visible := False;
// Add new Workbook
XLApp.Workbooks.Add(xlWBatWorkSheet);
Sheet := XLApp.Workbooks[1].WorkSheets[1];
Sheet.Name := ASheetName;
// Fill up the sheet
Sheet.Range[RefToCell(1, 1), RefToCell(AGrid.RowCount,
AGrid.ColCount)].Value := Data;
// Save Excel Worksheet
try
XLApp.Workbooks[1].SaveAs(AFileName);
Result := True;
except
// Error ?
end;
finally
// Quit Excel
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
XLAPP := Unassigned;
Sheet := Unassigned;
end;
end;
end;
// Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
if SaveAsExcelFile(stringGrid1, 'My Stringgrid Data', 'c:\MyExcelFile.xls') then
ShowMessage('StringGrid saved!');
end;
{**************************************************************}
{2. Without OLE }
procedure XlsWriteCellLabel(XlsStream: TStream; const ACol, ARow: Word;
const AValue: string);
var
L: Word;
const
{$J+}
CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
{$J-}
begin
L := Length(AValue);
CXlsLabel[1] := 8 + L;
CXlsLabel[2] := ARow;
CXlsLabel[3] := ACol;
CXlsLabel[5] := L;
XlsStream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel));
XlsStream.WriteBuffer(Pointer(AValue)^, L);
end;
function SaveAsExcelFile(AGrid: TStringGrid; AFileName: string): Boolean;
const
{$J+} CXlsBof: array[0..5] of Word = ($809, 8, 00, $10, 0, 0); {$J-}
CXlsEof: array[0..1] of Word = ($0A, 00);
var
FStream: TFileStream;
I, J: Integer;
begin
Result := False;
FStream := TFileStream.Create(PChar(AFileName), fmCreate or fmOpenWrite);
try
CXlsBof[4] := 0;
FStream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
for i := 0 to AGrid.ColCount - 1 do
for j := 0 to AGrid.RowCount - 1 do
XlsWriteCellLabel(FStream, I, J, AGrid.cells[i, j]);
FStream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
Result := True;
finally
FStream.Free;
end;
end;
// Example:
procedure TForm1.Button2Click(Sender: TObject);
begin
if SaveAsExcelFile(StringGrid1, 'c:\MyExcelFile.xls') then
ShowMessage('StringGrid saved!');
end;
{**************************************************************}
{3. Code by Reinhard Schatzl }
uses
ComObj;
// Hilfsfunktion für StringGridToExcelSheet
// Helper function for StringGridToExcelSheet
function RefToCell(RowID, ColID: Integer): string;
var
ACount, APos: Integer;
begin
ACount := ColID div 26;
APos := ColID mod 26;
if APos = 0 then
begin
ACount := ACount - 1;
APos := 26;
end;
if ACount = 0 then
Result := Chr(Ord('A') + ColID - 1) + IntToStr(RowID);
if ACount = 1 then
Result := 'A' + Chr(Ord('A') + APos - 1) + IntToStr(RowID);
if ACount > 1 then
Result := Chr(Ord('A') + ACount - 1) + Chr(Ord('A') + APos - 1) + IntToStr(RowID);
end;
// StringGrid Inhalt in Excel exportieren
// Export StringGrid contents to Excel
function StringGridToExcelSheet(Grid: TStringGrid; SheetName, FileName: string;
ShowExcel: Boolean): Boolean;
const
xlWBATWorksheet = -4167;
var
SheetCount, SheetColCount, SheetRowCount, BookCount: Integer;
XLApp, Sheet, Data: OLEVariant;
I, J, N, M: Integer;
SaveFileName: string;
begin
//notwendige Sheetanzahl feststellen
SheetCount := (Grid.ColCount div 256) + 1;
if Grid.ColCount mod 256 = 0 then
SheetCount := SheetCount - 1;
//notwendige Bookanzahl feststellen
BookCount := (Grid.RowCount div 65536) + 1;
if Grid.RowCount mod 65536 = 0 then
BookCount := BookCount - 1;
//Create Excel-OLE Object
Result := False;
XLApp := CreateOleObject('Excel.Application');
try
//Excelsheet anzeigen
if ShowExcel = False then
XLApp.Visible := False
else
XLApp.Visible := True;
//Workbook hinzufügen
for M := 1 to BookCount do
begin
XLApp.Workbooks.Add(xlWBATWorksheet);
//Sheets anlegen
for N := 1 to SheetCount - 1 do
begin
XLApp.Worksheets.Add;
end;
end;
//Sheet ColAnzahl feststellen
if Grid.ColCount <= 256 then
SheetColCount := Grid.ColCount
else
SheetColCount := 256;
//Sheet RowAnzahl feststellen
if Grid.RowCount <= 65536 then
SheetRowCount := Grid.RowCount
else
SheetRowCount := 65536;
//Sheets befüllen
for M := 1 to BookCount do
begin
for N := 1 to SheetCount do
begin
//Daten aus Grid holen
Data := VarArrayCreate([1, Grid.RowCount, 1, SheetColCount], varVariant);
for I := 0 to SheetColCount - 1 do
for J := 0 to SheetRowCount - 1 do
if ((I + 256 * (N - 1)) <= Grid.ColCount) and
((J + 65536 * (M - 1)) <= Grid.RowCount) then
Data[J + 1, I + 1] := Grid.Cells[I + 256 * (N - 1), J + 65536 * (M - 1)];
//-------------------------
XLApp.Worksheets[N].Select;
XLApp.Workbooks[M].Worksheets[N].Name := SheetName + IntToStr(N);
//Zellen als String Formatieren
XLApp.Workbooks[M].Worksheets[N].Range[RefToCell(1, 1),
RefToCell(SheetRowCount, SheetColCount)].Select;
XLApp.Selection.NumberFormat := '@';
XLApp.Workbooks[M].Worksheets[N].Range['A1'].Select;
//Daten dem Excelsheet übergeben
Sheet := XLApp.Workbooks[M].WorkSheets[N];
Sheet.Range[RefToCell(1, 1), RefToCell(SheetRowCount, SheetColCount)].Value :=
Data;
end;
end;
//Save Excel Worksheet
try
for M := 1 to BookCount do
begin
SaveFileName := Copy(FileName, 1,Pos('.', FileName) - 1) + IntToStr(M) +
Copy(FileName, Pos('.', FileName),
Length(FileName) - Pos('.', FileName) + 1);
XLApp.Workbooks[M].SaveAs(SaveFileName);
end;
Result := True;
except
// Error ?
end;
finally
//Excel Beenden
if (not VarIsEmpty(XLApp)) and (ShowExcel = False) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
XLAPP := Unassigned;
Sheet := Unassigned;
end;
end;
end;
//Example
procedure TForm1.Button1Click(Sender: TObject);
begin
//StringGrid inhalt in Excel exportieren
//Grid : stringGrid, SheetName : stringgrid Print, Pfad : c:\Test\ExcelFile.xls, Excelsheet anzeigen
StringGridToExcelSheet(StringGrid, 'Stringgrid Print', 'c:\Test\ExcelFile.xls', True);
end;

複製代碼