快速导出数据到Excel（一）：利用剪贴板

将数据导出到Excel的方法有多种，速度有快慢之分，我用过三种方法，速度都比较快，下面的一种是通过剪贴板进行，不过在个别W2K以上的系统，由于字符集编码不同，中文内容导出到Excel后可能变成乱码。

//显示进度条面板
procedure ShowProgress(Min, Max, Position: integer);
begin
    pnlProgress.Left := (ClientWidth - pnlProgress.Width) div 2;
    ProgressBar1.Min := Min;
    ProgressBar1.Max := Max;
    ProgressBar1.Position := Position;
    pnlProgress.Visible := true;
    pnlProgress.Update;
end;

//将数据库数据添加到DataList
function GetDataList(DataList: TStringList): Boolean;
var
    S: string;
    i: integer;
begin
    Result := true;
    DataList.Clear;
    try try
        DataList.Add('这是标题');
        ProgressBar1.StepIt;
        ADOQuery1.DisableControls;

        with ADOQuery1 do begin
            First;
            S := '';
            for i:=0 to FieldCount-1 do
                if Fields[i].Visible then
                    S := S + Fields[i].DisplayLabel + #9; //先导出字段名，用制表符分开
            DataList.Add(S);
            ProgressBar1.StepIt;

            While Not Eof do begin
                S := '';
                for i:=0 to FieldCount-1 do
                    if Fields[i].Visible then
                        S := S + Fields[i].DisplayText + #9;//导出数据显示内容
                DataList.Add(S);
                ProgressBar1.StepIt;
                Application.ProcessMessages;
                Next;
            end;
        end;
    except
        Result := false;
    end;
    finally
        ADOQuery1.EnableControls;
    end;
end;

function ExportByClipboard: Boolean;
var
    List: TStringList;
    FileName: string;
    ASheet: Variant;
begin
    ShowProgress(0, ADOQuery1.RecordCount+3, 0);
    Result := true;
    FileName := 'C:\abc.xls';
    Excel.Connect; //Excel: TExcelApplication控件
    try try
        Excel.DisplayAlerts[0] := false;
        Excel.Visible[0] := false;
        Excel.Caption := 'XXXXX导出(Excel)';
        Excel.Workbooks.Add(xlWBATWorksheet, 0);
        ASheet := Excel.Worksheets.Item[1];
        //设定默认格式
        Excel.Cells.Font.Name := '宋体';
        Excel.Cells.Font.Size := 10;
        Excel.Cells.VerticalAlignment := 2;
        //设定标题格式
        Excel.Range['A1', 'Z1'].HorizontalAlignment := 7;
        Excel.Range['A1', 'Z1'].Font.Size := 16;
        Excel.Range['A1', 'Z1'].RowHeight := 22;
        Excel.Range['A2', 'Z2'].HorizontalAlignment := 3;
        Excel.Range['A2', 'Z2'].Font.Bold := true;

        List := TStringList.Create;
        try try
            if GetDataList(List) then begin
                //锁定计算机并将数据粘到Excel里
                BlockInput(true);
                Clipboard.AsText := List.Text;
                ASheet.Paste;
                Clipboard.Clear;
                BlockInput(false);
                ProgressBar1.StepIt;
            end;
        finally
            List.Free;
        end;
        except
            Result := false;
            pnlProgress.Visible := false;
            Exit;
        end;
        ProgressBar1.StepIt;
        Excel.Workbooks.Item[1].SaveCopyAs(FileName, 0);
        Excel.Workbooks.Item[1].Close(false, FileName, 0, 0);
    finally
        Excel.Quit;
        Excel.Disconnect;
    end;
    except
        Result := false;
        pnlProgress.Visible := false;
        Exit;
    end;

    ProgressBar1.Position := ProgressBar1.Max;
    MessageBox(Handle, PChar('数据成功导出到' + FileName), '导出数据', MB_ICONINFORMATION or MB_OK);
    pnlProgress.Visible := false;
end;