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

【 tulaoshi.com - 编程语言 】

　　//显示进度条面板
　　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;