把DBGridEh导入到Excell中

来源：互联网发布：排列组合公式算法c50 编辑：程序博客网时间：2024/05/01 04:37

//经对以下代码测试，其FTitleName必须设置，否则会出现错误。

unit DBGridEhToExcel;
interface
uses
SysUtils, Variants, Classes, Graphics, Controls, Forms, Excel2000, ComObj,
Dialogs, DB, DBGridEh, SUIThemes, SUIProgressBar, SUIImagePanel;

type

TDBGridEhToExcel = class(TComponent)
private
    FProgressForm: TForm;                                  {进度窗体}
    FtempGauge: TsuiProgressBar;                           {进度条}
    FShowProgress: Boolean;                                {是否显示进度窗体}
    FShowOpenExcel:Boolean;                                {是否导出后打开Excel文件}
    FDBGridEh: TDBGridEh;
    FTitleName: TCaption;                                  {Excel文件标题}
    FUserName: TCaption;                                   {制表人}
    procedure SetShowProgress(const Value: Boolean);       {是否显示进度条}
    procedure SetShowOpenExcel(const Value: Boolean);      {是否打开生成的Excel文件}
    procedure SetDBGridEh(const Value: TDBGridEh);
    procedure SetTitleName(const Value: TCaption);         {标题名称}
    procedure SetUserName(const Value: TCaption);          {使用人名称}
    procedure CreateProcessForm(AOwner: TComponent);       {生成进度窗体}
public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ExportToExcel; {输出Excel文件}
published
    property DBGridEh: TDBGridEh read FDBGridEh write SetDBGridEh;
    property ShowProgress: Boolean read FShowProgress write SetShowProgress;    //是否显示进度条
    property ShowOpenExcel: Boolean read FShowOpenExcel write SetShowOpenExcel; //是否打开Excel
    property TitleName: TCaption read FTitleName write SetTitleName;
    property UserName: TCaption read FUserName write SetUserName;
end;

implementation
procedure Register;
begin
RegisterComponents('Ehlib', [TDBGridEhToExcel]);
end;
constructor TDBGridEhToExcel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FShowProgress := True;
FShowOpenExcel:= True;

FTitleName:='标题';
end;

procedure TDBGridEhToExcel.SetShowProgress(const Value: Boolean);
begin
FShowProgress := Value;
end;

procedure TDBGridEhToExcel.SetDBGridEh(const Value: TDBGridEh);
begin
FDBGridEh := Value;
end;

procedure TDBGridEhToExcel.SetTitleName(const Value: TCaption);
begin
FTitleName := Value;
end;

procedure TDBGridEhToExcel.SetUserName(const Value: TCaption);
begin
FUserName := Value;
end;

procedure TDBGridEhToExcel.ExportToExcel;
var
XLApp: Variant;
Sheet: Variant;
s1, s2: string;
Caption: String;
Row, Col: integer;
iCount, jCount: Integer;
FBookMark: TBookmark;
FileName: String;
SaveDialog1: TSaveDialog;
begin
//如果数据集为空或没有打开则退出
if not DBGridEh.DataSource.DataSet.Active then Exit;

    SaveDialog1 := TSaveDialog.Create(Nil);
    SaveDialog1.FileName := TitleName + '_' + FormatDateTime('YYMMDD', Date);
    SaveDialog1.Filter := 'Excel文件|*.xls';
    if SaveDialog1.Execute then
        FileName := SaveDialog1.FileName;
    SaveDialog1.Free;
    if FileName = '' then Exit;

Application.ProcessMessages;

    Screen.Cursor := crHourGlass;
    //显示进度窗体
    if ShowProgress then
        CreateProcessForm(nil);

    if not VarIsEmpty(XLApp) then
    begin
        XLApp.DisplayAlerts := False;
        XLApp.Quit;
        VarClear(XLApp);
    end;

    //通过ole创建Excel对象
    try
        XLApp := CreateOleObject('Excel.Application');
    except
        MessageDlg('创建Excel对象失败，请检查你的系统是否正确安装了Excel软件！', mtError, [mbOk], 0);
        Screen.Cursor := crDefault;
        Exit;
    end;

    //生成工作页
    XLApp.WorkBooks.Add[XLWBatWorksheet];
    XLApp.WorkBooks[1].WorkSheets[1].Name := TitleName;
    Sheet := XLApp.Workbooks[1].WorkSheets[TitleName];

    //写标题
    sheet.cells[1, 1] := TitleName;
    sheet.range[sheet.cells[1, 1], sheet.cells[1, DBGridEh.Columns.Count]].Select; //选择该列
    XLApp.selection.HorizontalAlignment := $FFFFEFF4;                               //居中
    XLApp.selection.MergeCells := True;                                             //合并

    //写表头
    Row := 1;
    jCount := 3;
    for iCount := 0 to DBGridEh.Columns.Count - 1 do
    begin
        Col := 2;
        Row := iCount+1;
        Caption := DBGridEh.Columns[iCount].Title.Caption;
        while POS('|', Caption) > 0 do
        begin
            jCount := 4;
            s1 := Copy(Caption, 1, Pos('|',Caption)-1);
            if s2 = s1 then
            begin
                sheet.range[sheet.cells[Col, Row-1],sheet.cells[Col, Row]].Select;
                XLApp.selection.HorizontalAlignment := $FFFFEFF4;
                XLApp.selection.MergeCells := True;
            end
            else
                Sheet.cells[Col,Row] := Copy(Caption, 1, Pos('|',Caption)-1);
            Caption := Copy(Caption,Pos('|', Caption)+1, Length(Caption));
            Inc(Col);
            s2 := s1;
        end;
        Sheet.cells[Col, Row] := Caption;
        Inc(Row);
    end;

    //合并表头并居中
    if jCount = 4 then
        for iCount := 1 to DBGridEh.Columns.Count do
            if Sheet.cells[3, iCount].Value = '' then
            begin
                sheet.range[sheet.cells[2, iCount],sheet.cells[3, iCount]].Select;
                XLApp.selection.HorizontalAlignment := $FFFFEFF4;
                XLApp.selection.MergeCells := True;
            end
            else begin
                sheet.cells[3, iCount].Select;
                XLApp.selection.HorizontalAlignment := $FFFFEFF4;
            end;

    //读取数据
    DBGridEh.DataSource.DataSet.DisableControls;
    FBookMark := DBGridEh.DataSource.DataSet.GetBookmark;
    DBGridEh.DataSource.DataSet.First;
    while not DBGridEh.DataSource.DataSet.Eof do
    begin
        for iCount := 1 to DBGridEh.Columns.Count do
          Sheet.cells[jCount, iCount] := DBGridEh.Columns.Items[iCount-1].Field.AsString;
        Inc(jCount);

        //显示进度条进度过程
        if ShowProgress then
        begin
            FtempGauge.Position := DBGridEh.DataSource.DataSet.RecNo;
            FtempGauge.Refresh;
        end;

        DBGridEh.DataSource.DataSet.Next;
    end;
    if DBGridEh.DataSource.DataSet.BookmarkValid(FBookMark) then
        DBGridEh.DataSource.DataSet.GotoBookmark(FBookMark);
    DBGridEh.DataSource.DataSet.EnableControls;

    //读取表脚
    if DBGridEh.FooterRowCount > 0 then
    begin
        for Row := 0 to DBGridEh.FooterRowCount-1 do
        begin
            for Col := 0 to DBGridEh.Columns.Count-1 do
                Sheet.cells[jCount, Col+1] := DBGridEh.GetFooterValue(Row,DBGridEh.Columns[Col]);
            Inc(jCount);
        end;
    end;

    //调整列宽
    for iCount := 1 to DBGridEh.Columns.Count do
        Sheet.Columns[iCount].EntireColumn.AutoFit;

sheet.cells[1, 1].Select;
XlApp.Workbooks[1].SaveAs(FileName);

XlApp.Visible := True;
XlApp := Unassigned;

    if ShowProgress then
        FreeAndNil(FProgressForm);
    Screen.Cursor := crDefault;

end;

destructor TDBGridEhToExcel.Destroy;
begin
inherited Destroy;
end;

procedure TDBGridEhToExcel.CreateProcessForm(AOwner: TComponent);
var
Panel: TsuiPanel;
begin
if Assigned(FProgressForm) then
exit;

FProgressForm := TForm.Create(AOwner);
with FProgressForm do
begin
    try
      Font.Name := '宋体';                                  {设置字体}
      Font.Size := 10;
      BorderStyle := bsNone;
      Width := 300;
      Height := 60;
      BorderWidth := 1;
      Color := clBlack;
      Position := poScreenCenter;
      Panel := TsuiPanel.Create(FProgressForm);
      with Panel do
      begin
        Parent := FProgressForm;
        Align := alClient;
        Caption := '正在导出Excel，请稍候......';
        UIStyle:=WinXP;
        Color:=$00E9E5E0;
     end;
      FtempGauge:=TsuiProgressBar.Create(Panel);
      with FtempGauge do
      begin
        Parent := Panel;
        Align:=alClient;
        UIStyle:=MacOS;
        Min := 0;
        Max:= DBGridEh.DataSource.DataSet.RecordCount;
        Position := 0;
      end;
    except

end;
end;
FProgressForm.Show;
FProgressForm.Update;
end;

procedure TDBGridEhToExcel.SetShowOpenExcel(const Value: Boolean);
begin
FShowOpenExcel:=Value;
end;

end.