增强型DBGrid2Excel-- 支持标题粗体,对齐格式与避免科学计算法 选择自 dogbear2000 的 Blog
关键字 增强型DBGrid2Excel-- 支持标题粗体,对齐格式与避免科学计算法
出处
unit dbgrid2excel;
{
功能描述：把DBGrid输出到Excel表格（支持多Sheet）
调用格式：DBGridToExcel([DBGrid1, DBGrid2]);
对于数字用AsString, 其它可能含有格式的文本用DisplayText
长数字字符 的Tag C_LongNumber_FieldTag = 9; 避免科学计算格式，如身份证号的显示
自动采用对齐属性, 标题粗体
}
interface
uses
classes, comctrls, stdctrls, windows, Dialogs, controls, SysUtils,
Db,DBGrids,forms,ComObj,Variants;
const
C_LongNumber_FieldTag = 9;
//这些不可运算文字可能含有格式
function MayHasFormatText(const AFieldType:TFieldType):Boolean;
procedure DBGridToExcel(Args: array of const);
implementation
function MayHasFormatText(const AFieldType:TFieldType):Boolean;
begin
Result := AFieldType in
[ftBoolean, ftDate, ftTime, ftDateTime, ftTimeStamp,
ftString, ftFixedChar, ftWideString] ;
end;
{
功能描述：把DBGrid输出到Excel表格（支持多Sheet）
调用格式：DBGridToExcel([DBGrid1, DBGrid2]);
}
procedure DBGridToExcel(Args: array of const);
const
xlHAlignCenter = -4108;
xlHAlignLeft = -4131;
xlHAlignRight = -4152;
var
iCount, jCount: Integer;
XLApp: Variant;
Sheet: Variant;
I: Integer;
BK : TBookMark;
DataSet:TDataSet;
Col : TColumn;
CellStr : string;
GAL :TAlignment;
EAL : Integer;
begin
Screen.Cursor := crHourGlass;
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
VarClear(XLApp);
end;
try
XLApp := CreateOleObject('Excel.Application');
except
Screen.Cursor := crDefault;
Exit;
end;
XLApp.WorkBooks.Add;
XLApp.SheetsInNewWorkbook := High(Args) + 1;
for I := Low(Args) to High(Args) do
begin
XLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGrid(Args.VObject).Name;
Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args.VObject).Name];
if not TDBGrid(Args.VObject).DataSource.DataSet.Active then
begin
Screen.Cursor := crDefault;
Exit;
end;
DataSet := TDBGrid(Args.VObject).DataSource.DataSet;
DataSet.DisableControls;
BK := DataSet.GetBookmark();
DataSet.First;
//标题
for iCount := 0 to TDBGrid(Args.VObject).Columns.Count - 1 do
begin
Col := TDBGrid(Args.VObject).Columns.Items[iCount];
Sheet.Cells[1, iCount + 1] := Col.Title.Caption;
Sheet.Cells[1, iCount + 1].Font.Bold :=True ;//粗体
GAL := Col.Alignment;
if GAL = taLeftJustify then
EAL := xlHAlignLeft
else if GAL = taCenter then
EAL := xlHAlignCenter
else EAL := xlHAlignRight;
//列数据对齐格式
Sheet.Columns[iCount + 1].HorizontalAlignment := EAL ;
//列标题对齐格式
Sheet.Cells[1, iCount + 1].HorizontalAlignment := xlHAlignCenter;
//自定义格式, 避免把长数字字符转换为科学记数法
if Col.Field.Tag=C_LongNumber_FieldTag then
Sheet.Columns[iCount + 1].NumberFormatLocal :='@';
end;
//数据
jCount := 1;
while not DataSet.Eof do
begin
for iCount := 0 to TDBGrid(Args.VObject).Columns.Count - 1 do
begin
Col := TDBGrid(Args.VObject).Columns.Items[iCount];
if MayHasFormatText(Col.Field.DataType) then
CellStr := Col.Field.DisplayText
else
CellStr:= Col.Field.AsString;
Sheet.Cells[jCount + 1, iCount + 1] := CellStr;
end;
Inc(jCount);
DataSet.Next;
Application.ProcessMessages;
end;
DataSet.GotoBookmark(BK);
DataSet.FreeBookmark(BK);
DataSet.EnableControls;
XlApp.Visible := True; //用户关掉, 就可以关掉内存中的Excel试验通过2005.2.5
Sheet := unAssigned; //可以不要
end;
Screen.Cursor := crDefault;
end;
end.
作者Blog：http://blog.csdn.net/dogbear2000/
