增强型DBGrid2Excel-- 支持标题粗体,对齐格式与避免科学计算法

类别:Delphi 点击:0 评论:0 推荐:

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[I].VObject).Name; Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args[I].VObject).Name]; if not TDBGrid(Args[I].VObject).DataSource.DataSet.Active then begin Screen.Cursor := crDefault; Exit; end; DataSet := TDBGrid(Args[I].VObject).DataSource.DataSet; DataSet.DisableControls; BK := DataSet.GetBookmark(); DataSet.First; //标题 for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do begin Col := TDBGrid(Args[I].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[I].VObject).Columns.Count - 1 do begin Col := TDBGrid(Args[I].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.

本文地址:http://com.8s8s.com/it/it4338.htm