delphi读写excel的代码片断

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, {if delphi6.0 add ...}Variants{d6};

type
  TForm1 = class(TForm)
    Button1: TButton;
    CheckBox1: TCheckBox;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    v:Variant;
    Sheet: Variant;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses Comobj;

//打开EXCEL新建文件
procedure TForm1.Button1Click(Sender: TObject);
begin
  try
    v:= CreateOleObject('Excel.Application');
    v.Visible := CheckBox1.Checked;//是否显示
    v.Workbooks.Add;//新建EXCEL文件
    v.Workbooks[1].WorkSheets[1].Name := 'DELPHI演示';
//    Sheet:= v.Workbooks[1].WorkSheets['DELPHI演示'];//等效下面的语句
    Sheet:= v.Workbooks[1].WorkSheets[1];
    Sheet.Cells[1,1] :='DELPHI盒子';
    Sheet.Cells[2,1] :='http://www.delphibox.com';
  except
    Showmessage('初始化Excel失败，可能没装Excel，或者其他错误；请重起再试。');
    v.DisplayAlerts := false;//是否提示存盘
    v.Quit;//如果出错则退出
    exit;
  end;
  Application.Restore;
  Application.BringToFront;
end;

//打开存在的EXCEL文档
procedure TForm1.Button2Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    try
      v:= CreateOleObject('Excel.Application');
      v.Visible := CheckBox1.Checked;
      v.Workbooks.Open(OpenDialog1.FileName);
  //    Sheet := v.Workbooks[1].WorkSheets[1];
    except
      Showmessage('初始化Excel失败，可能没装Excel，或者其他错误；请重起再试。');
      v.DisplayAlerts := false;
      v.Quit;
      exit;
    end;
    Application.Restore;
    Application.BringToFront;
  end;
end;

//关闭EXCEL并退出
procedure TForm1.Button3Click(Sender: TObject);
begin
  try
    If not varIsEmpty(v) then
    begin
  //    如果需要在关闭前确定是否存盘，加入：
  //    v.DiaplayAlert:=true; //确定存盘
  //    v.DiaplayAlert:=false;//不存盘，直接退出
      v.WorkBooks[1].Close(True, 'C:\untitled.xls'); //取文件名退出
      v.quit;
    end;
  finally
    Close;
  end;
end;

//EXCEL打印页面设置
procedure TForm1.Button4Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    try
      v:= CreateOleObject('Excel.Application');
      v.Visible := CheckBox1.Checked;
      v.Workbooks.Open(OpenDialog1.FileName);
      Sheet:=v.Workbooks[1].WorkSheets[1];
      Sheet.PageSetup.PrintTitleRows :='$1:$3'; //页眉
      Sheet.PageSetup.PrintTitleColumns := '';
      Sheet.PageSetup.LeftFooter := ' 注：页脚'+' 总共&N页'+'--第&P页'; //页脚
      Sheet.PageSetup.LeftMargin := 30; //设置边距
      Sheet.PageSetup.RightMargin := 30;
      Sheet.PageSetup.TopMargin := 30;
      Sheet.PageSetup.BottomMargin := 50;
    //  Sheet.PageSetup.PrintQuality := 400; //分辨率(根据打印机确定)
      Sheet.PageSetup.CenterHorizontally := True;//是否水平居中
      Sheet.PageSetup.CenterVertically := True; //是否垂直居中
      Sheet.PageSetup.Orientation := 2; //横向打印
      Sheet.PageSetup.Draft := False; //非草稿模式
    //  Sheet.PageSetup.FirstPageNumber := xlAutomatic;
      Sheet.PageSetup.BlackAndWhite := True; //黑白稿
      Sheet.PageSetup.Zoom := 100; //缩放
      sheet.PrintPreView; //打印预览
    except
      Showmessage('初始化Excel失败，可能没装Excel，或者其他错误；请重起再试。');
      v.DisplayAlerts := false;
      v.Quit;
      exit;
    end;
  end;
end;

//EXCEL文档格式设置
procedure TForm1.Button5Click(Sender: TObject);
var
  Range: Variant;
begin
  if OpenDialog1.Execute then
  begin
    try
      v:= CreateOleObject('Excel.Application');
      v.Visible := CheckBox1.Checked;
      v.Workbooks.Open(OpenDialog1.FileName);
      Range := v.Workbooks[1].WorkSheets[1].Range['A2:G2'];//单元格从A2到M2
      Range.Merge; //合并单元格
      Range.Rows.RowHeight := 50; //设置行高
      Range.Borders.LineStyle := 1; //加边框
      Range.Columns[2].ColumnWidth := 12; // 设置列宽
      Range.FormulaR1C1 := '合并区';
      Range.HorizontalAlignment := 3;//xlCenter(水平对齐方式)
      Range.VerticalAlignment := 2;//xlCenter(垂直对齐方式)
      Range.Characters.Font.Name := '宋体'; //字体
      Range.Characters.Font.FontStyle := '加粗';
      Range.Characters.Font.Size := 15;
      Range.Characters.Font.OutlineFont := False; //是否有下划线
      Range.Characters.Font.ColorIndex := 0;//xlAutomatic; //颜色
    except
      Showmessage('初始化Excel失败，可能没装Excel，或者其他错误；请重起再试。');
      v.DisplayAlerts := false;
      v.Quit;
      exit;
    end;
  end;
end;

end.

 

procedure TF_Payee.BitBtn4Click(Sender: TObject);
var
  ExcelApp,WorkSheets: Variant;
  FileNames: String;
  I, J, K: integer;
begin
  if not DM.Query2.Active then begin
    MessageBox(Handle,'您并未对数据库进行查询操作，无记录可以导出！', AppName, MB_OK+MB_ICONWarning);
    Exit;
    end;
    try
    ExcelApp := CreateOLEObject('Excel.Application');
    Except
    MessageBox(Handle,'您的操作系统中尚未安装Microsoft Office或Excel组件，无法导出！', AppName, MB_ICONSTOP+MB_OK);
    Exit;
    end;
    SaveDiaLog1.InitialDir := ExtractFilePath(ParamStr(0));
    if SaveDialog1.Execute then begin
      FileNames := SaveDialog1.FileName;
      ExcelApp.WorkBooks.Add;
      WorkSheets := ExcelApp.WorkBooks[1].WorkSheets[1];
      DM.Query2.DisableControls;
      DM.Query2.First;
      J := 0;
      WorkSheets.Cells[1,1] := F_Main.StatusBar1.Panels[1].Text+'收款单位基本信息表';
      while not DM.Query2.Eof do begin
        K := 0;
        for I := 0 to DM.Query2.FieldCount - 1 do
          if Dm.Query2.Fields[i].Visible then begin//只导出可见的字段
          WorkSheets.cells[2,K+1] := DM.query2.Fields.Fields[I].DisplayLabel;
          WorkSheets.Cells[J+3,K+1] := DM.Query2.Fields[I].asstring;
          Inc(K);
          end;
        INC(J);
        DM.Query2.Next;
      end;
      WorkSheets.SaveAs(FileNames);
      ExcelApp.quit;
      ExcelApp := UnAssigned;
      DM.Query2.EnableControls;
      MessageBox(Self.Handle,'数据导出到Excel文件成功！',AppName,MB_OK+MB_ICONInformation);
    end;
end;