快速导出数据到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;