将DBGrid中的数据导入Excel表格中-优快云博客

procedure TForm1.SpeedButton5Click(Sender: TObject);
var
  Excel,WrkBook,WrkSheet:olevariant;

Begin
 try
    Excel := CreateOleObject('Excel.Application');
  except
    if Application.MessageBox('对不起，你的机器没有安装Microsoft Excel,是否继续导出?' + #13#13 + '导出后在您的机器上不能直接打开,必须安装Excel到机器上才能打开!', '注意', MB_OKCANCEL) = ID_no then
      Exit;
  end;
  if SaveDialog1.Execute then
  Begin
   FormMain.StatusBarMain.Panels[1].Text := '系统正在导出,请稍后......';
   WrkBook:=Excel.WorkBooks.Add;
   Row := 1;
   SheetCount:=1;
    while not Query1.Eof do
      Begin
        if Row=1 then
           for tmp := 0 to s_caption.Count - 1 do     //插入加入标题:
               Excel.WorkSheets[SheetCount].Cells[Row,tmp+1].Value:=s_caption.Strings[tmp];
        inc(Row);
        for tmp := 0 to Query1.FieldCount - 1 do
        Begin
           if Query1.Fields[tmp].FieldName='VIP_NO' then
              Excel.WorkSheets[SheetCount].cells[Row, Tmp + 1].NumberFormatLocal:= '@'  ;
            Excel.WorkSheets[SheetCount].Cells[Row,Tmp+1].Value := Query1.Fields[tmp].AsString;
        End;
        if Row&gt;50000 then
           Begin
            SheetCount:=SheetCount+1;
             Row:=0;
            if SheetCount&gt;3 then
              Begin
               WrkSheet:=WrkBook.WorkSheets[WrkBook.WorkSheets.Count];
               WrkBook.WorkSheets.Add(emptyparam,WrkSheet,1,$FFFFEFB9);
              End;
           End;
        Query1.Next;
        ProgressBar1.StepIt;
      End;
   Excel.Activeworkbook.saveas(SaveDialog1.FileName);
   WrkBook.close;
   Excel.quit ;
   Excel:=unassigned ;
   ShowMessage('系统已经导出,请到'+SaveDialog1.FileName+'里查看');
end;