快速導出數據到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;