Delphi OLE方法操作Excel

 

Delphi OLE方法操作Excel 

来源：http://www.ltesting.net/ceshi/ruanjianceshikaifajishu/rjcskfyy/2008/0519/154269.html 

 

引用下面单元文件

Uses ComObj, Variants; 

 

首先创建 Excel 对象，使用ComObj: 

var ExcelApp: Variant;

ExcelApp := CreateOleObject( ’Excel.Application’ ); 

 注意程序结束时释放变量 ExcelApp:=unassigned;   

 

1 显示当前窗口： ExcelApp.Visible := True;   

2 更改 Excel标题栏： ExcelApp.Caption := ’应用程序调用 Microsoft Excel’; 

3 添加新工作簿： ExcelApp.WorkBooks.Add; 

4 添加工作表 ExcelApp.WorkSheets.add;

5 打开已存在的工作簿： ExcelApp.WorkBooks.Open( ’C:ExcelDemo.xls’ ); 

6 设置第2个工作表为活动工作表： 

ExcelApp.WorkSheets[2].Activate; 或 ExcelApp.WorksSheets[ ’Sheet2’ ].Activate; 

 

【导出Excel范例】

来源: http://zhidao.baidu.com/question/154677351.html

procedure QueryToExcel(Q:TAdoQuery;Tit:string;FileName:string);

var

  XlApp,XlWorkbook,XlSheet:Olevariant;

  i,j:integer;

  Range:OleVariant;

begin

  Try

  XlApp:=createOleObject('Excel.Application');

  XLApp.visible:=false;

  XlWorkbook:=XlApp.workbooks.add;

  XlSheet:=Xlworkbook.sheets.add;

  except

  showmessage('你还没有安装Microsoft Excel,请先安装！');

  XlApp.Quit;

  XlSheet:=Unassigned;

  XlWorkbook:=Unassigned;

  Xlapp:=Unassigned;

  exit;

  end;

 

  for i:=0 to Q.FieldCount-1 do

    begin

      Xlsheet.Cells[1,i+1]:=Q.Fields[i].DisplayName ;

    end;

 

  for i:=1 to Q.RecordCount do

    begin

      for j:=0 to Q.FieldCount -1 do

        begin

          if ((j=0) or (j=6) or (j=22)) and (Q.Fields[j].AsString<>'') then

            Xlsheet.cells[i+1,j+1]:=''''+Q.Fields[j].Asstring else

            Xlsheet.cells[i+1,j+1]:=Q.Fields[j].AsString;

        end;

      Q.Next;

    end;

 

  Xlsheet.rows[1].insert;

  Range:=Xlsheet.range[XlSheet.cells[1,1],XlSheet.cells[1,Q.FieldCount-DelCollist.count]];

  Range.merge;

  Range.HorizontalAlignment:= xlCenter;

  Range.VerticalAlignment:= xlCenter;

  Range.WrapText:=true;

  Range.Font.size:=14;

  Xlsheet.cells[1,1]:=Tit;

 

  Xlsheet.Columns.EntireColumn.AutoFit;

 

  if FileExists(FileName) then

    begin

      if MessageDlg('文件已经存在，要替换吗？',mtConfirmation,[mbyes,mbno],0)=mrno then

        begin

          XlApp.Quit;

          XlSheet:=Unassigned;

          XlWorkbook:=Unassigned;

          Xlapp:=Unassigned;

          exit;

        end;

    end;

  try

  XlWorkbook.SaveAs(FileName);

  except

  showmessage('导出失败，请检查你对该文件是否有写权限！');

  XlApp.Quit;

  XlSheet:=Unassigned;

  XlWorkbook:=Unassigned;

  Xlapp:=Unassigned;

  exit;

  end;

  showmessage('导出成功！请不要改动导出的Excel表中的列标题！否则将不能将该Excel表再导入！');

  XlWorkBook.Saved:=true;

  XlApp.Quit;

  XlSheet:=Unassigned;

  XlWorkbook:=Unassigned;

  Xlapp:=Unassigned;

//  XlSheet:=Unassigned;

//  XlWorkbook:=Unassigned;

//  XlApp:=Unassigned;

end;

慢慢看吧

调用这个过程

 SaveDialog1.Filter:='Microsoft Excel|*.xls';

  if SaveDialog1.Execute then

    begin

      if SaveDialog1.FileName <>'' then

        begin

          FilesName:=SaveDialog1.FileName;

          TitleName:='XXXX基本信息表';

          QueryToExcel(DataM.Qr_EquipmentDetails,TitleName,FilesName);

        end;

end;

 

【导入Excel范例】

procedure TfrmExcelIO.btnOkClick(Sender: TObject);

var

  sFileName: String;

  ExcelApp:variant;

  iRow, iCol: Integer;

  sSql, sValue: String;

begin

  sFileName := txtFile.Text;

  if not FileExists(sFileName) then

  begin

    ShowMyMsg('系统提示', '导入文件不存在，请重新选择！');

    Exit;

  end;

  //

  Screen.Cursor := crHourGlass;

  //

  if radNew.Checked then

  begin

    TSqlProc.Execute('truncate table stk_TMHS');

  end;

  //

  ExcelApp := CreateOleObject('Excel.Application');

  ExcelApp.visible:=False;

  ExcelApp.workbooks.open(sFileName);

  //自适应宽度

  ExcelApp.worksheets[1].Cells.EntireColumn.AutoFit; //整个表所有列

  labNumber.Caption := '';

  labNumber.Visible := True;

  iRow := 3;   //从第3行开始导入

  try

    while ExcelApp.worksheets[1].cells[iRow, 1].text <> '' do

    begin

      sSql := 'insert into stk_TMHS(Row, Tag, TaxState, OrdNo, CarNo, Model, CarInfo, BatteryBrand, Qty, MastHeight, ForkSize, Battery, BatteryCharger, TireType, Attachment, StockState, PONo, Remark) ' +

        'Values(';

      //有18列

      for iCol := 1 to 18 do

      begin

        sValue := ExcelApp.worksheets[1].cells[iRow, iCol].text;

        //

        if iCol = 1 then

          labNumber.Caption := sValue;

        //

        if not (iCol in [1, 9]) then

          sValue := QuotedStr(sValue);

        //

        if iCol = 18 then

          sSql := sSql + sValue + ')'

        else

          sSql := sSql + sValue + ',';

      end;

      //

      TSqlProc.Execute(sSql);

      //换一行

      iRow := iRow + 1;

    end;

    //

    labNumber.Visible := False;

    ExcelApp.Activeworkbook.close(false);

    ExcelApp.quit;

ExcelApp:=unassigned;   //释放变量ExcelApp, 去掉Excel.exe的进程

Screen.Cursor := crHourGlass;

    ShowMyMsg('系统提示', '导入完毕,共导入' + IntToStr(iRow - 3) + '行数据！');

  except

    labNumber.Visible := False;

    ExcelApp.Activeworkbook.close(false);

    ExcelApp.quit;

ExcelApp:=unassigned; //释放变量ExcelApp, 去掉Excel.exe的进程

    Screen.Cursor := crHourGlass;

    WarnMyMsg('系统提示', '导入第'+ IntToStr(iRow) + '行时出现错误, 请修正后再以追加模式导入！');

  end;

  //

  Self.ModalResult := mrOk;

end;