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>50000 then
           Begin
            SheetCount:=SheetCount+1;
             Row:=0;
            if SheetCount>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;
posted on 2017-09-06 16:03  敲代码的小女孩  阅读(365)  评论(0编辑  收藏  举报