delphi 调用excel宏

[dwtrace]

如题，那位大侠能给个例子，不甚感激！！！！

[de410]

http://blog.csdn.net/handsome1234/archive/2007/02/14/1509820.aspx

[Jack_Yin]

{****************************************************
//
Description :
  把一个表或Query或StringGrid中的数据保存到一个Execl文件中
Function List :
  创建接口
  procedure CreateExcelInstance;
  把表内容放到Excel文件中
  procedure TableToExcel( const Table: TTable );
  把Query内容放到Excel文件中
  procedure QueryToExcel( const Query: TQuery );
  把StringGrid内容放到Excel文件中
  procedure StringGridToExcel( const StringGrid: TStringGrid );
  保存为Execl文件
  procedure SaveToExcel( const FileName: String);

调用实例如下：
  OLEExcel1.CreateExcelInstance;
  OLEExcel1.QuerytoExcel((CurRep.DataSet as TQuery));
  OLEExcel1.SaveToExcel(SaveDlg1.FileName);
****************************************************}
unit OleExcel;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  comobj, DBTables, Grids,OleCtnrs,OleServer,Excel2000,Variants;
type
  FileCheckResult = (fcrNotExistend,fcrNotXSLFile,fcrValidXSL); //文件不存在,不是XSL文件,合法的XSL文件
  TOLEExcel = class(TComponent)
  private
    FExcelCreated: Boolean;
    FVisible: Boolean;
    FExcel: Variant;      //Excel程序对象
    FWorkBook: Variant;   //Excel工作簿对象
    FWorkSheet: Variant;  //Excel工作簿 工作表对象
    FCellFont: TFont;     //单元格字体对象
    FTitleFont: TFont;    //
    FFontChanged: Boolean;
    FIgnoreFont: Boolean;
    FFileName: TFileName;

    //********************************************自己添加*****************************//
    FCreateFromFile:Boolean;  //指示是否打开已有文件
    FExcelCaption:string;     //用程序打开Excel的窗体标

    //*********************************来自U_Report*****************************//
    FRCPrePage:Integer; //每页显示的记录数
    FMax:Integer;       //最大的数组个数

    procedure SetExcelCellFont(var Cell: Variant);
    procedure SetExcelTitleFont(var Cell: Variant);
    procedure GetTableColumnName(const Table: TTable; var Cell: Variant);
    procedure GetQueryColumnName(const Query: TQuery; var Cell: Variant);
    procedure GetFixedCols(const StringGrid: TStringGrid; var Cell: Variant);
    procedure GetFixedRows(const StringGrid: TStringGrid; var Cell: Variant);
    procedure GetStringGridBody(const StringGrid: TStringGrid; var Cell: Variant);

  protected
    procedure SetCellFont(NewFont: TFont);
    procedure SetTitleFont(NewFont: TFont);
    procedure SetVisible(DoShow: Boolean);
    function GetCell( ARow,ACol: Integer): string;
    procedure SetCell(ACol, ARow: Integer; const Value: string);

    function GetDateCell(ACol, ARow: Integer): TDateTime;
    procedure SetDateCell(ACol, ARow: Integer; const Value: TDateTime);

    //*********************************************自己添加************************************//
    procedure SetCaption(ACaption:string);//设置打开文件后,Excel主程序的窗体标题
    function GetCapiton:string;//返回打开文件后,Excel主程序的窗体标题

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CreateExcelInstance;
    property Cell[ACol, ARow: Integer]: string read GetCell write SetCell;
    property DateCell[ACol, ARow: Integer]: TDateTime read GetDateCell write SetDateCell;
    function IsCreated: Boolean;
    procedure TableToExcel(const Table: TTable);
    procedure QueryToExcel(const Query: TQuery);
    procedure StringGridToExcel(const StringGrid: TStringGrid);
    procedure SaveToExcel(const FileName: string);

    //*********************************来自U_Report*****************************//
    function  GetRepRange(x,y:integer):String;//将(x,y)坐标形式改为Excel区域(A1:B1)形式
    procedure CellMerge(x1,y1,x2,y2:integer);//合并指定单元格
    procedure SetRepLine(x1,x2,y1,y2:Integer); //加边框线
    procedure CellWrite(RepData:String;x,y:Integer);//单元格写数据
    procedure CellFormat(x1,y1,x2,y2:integer);//指定单元格格式
    procedure CellGS(x1,y1,x2,y2,f:integer);//灵活单元格格式

    procedure CreatRepSheet(SheetName:String;PageSize,PageLay:Integer);//给当前工作表重命名、进行页面设置 
    procedure SetAddMess(H_Mess1,H_Mess2,H_Mess3,F_Mess1,F_Mess2,F_Mess3:String);//设置附加信息
    procedure SetRepBody(x,ch:Integer;cw:Double;cf:String);//设置整体各列数据格式
    procedure CreatTitle(TitleName:String;y:Integer);//设置标题
    procedure CreatSubHead(SubTitle:Array of String); //设置常规子表头
    procedure SubHeadFormat(y,r:Integer);//设置子表头格式
    procedure DTSubHeadGS(x,y,r:Integer);//设置动态子表头格式
    procedure WriteData(RepData:String;x,y:Integer;flag:Integer=0); //写入数据
    procedure RepPageBreak(x,y,r:Integer);//分页、复制表头
    procedure RepSaveAs(FileName:String); //保存为*.xls文
    procedure RepPrivew;//预览

    //*********************************************自己添加************************************//
    function FileCheck:FileCheckResult;//检查文件
    function GetRowCount:Integer;
  published
    property TitleFont: TFont read FTitleFont write SetTitleFont;
    property CellFont: TFont read FCellFont write SetCellFont;
    property Visible: Boolean read FVisible write SetVisible;
    property IgnoreFont: Boolean read FIgnoreFont write FIgnoreFont;
    property FileName: TFileName read FFileName write FFileName;
    //*********************************来自U_Report*****************************//
    property RCPrePage:Integer read FRCPrePage write FRCPrePage;
    property MaxAC:Integer  read FMax write FMax;


    //*********************************************自己添加************************************//
    property CreateFromFile:Boolean read FCreateFromFile write FCreateFromFile;
    property Caption:string read GetCapiton write SetCaption;
  end;

procedure Register;

implementation

constructor TOLEExcel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIgnoreFont := True;
  FCellFont := TFont.Create;
  FTitleFont := TFont.Create;
  FExcelCreated := False;
  FVisible := False;//暂时不显示Excel窗体
  FCreateFromFile := False;//默认不是打开已有xls文件
  FFontChanged := False;
  FFileName := '';//默认文件名为空
end;

procedure TOLEExcel.CreateExcelInstance;
var
  myFileCheckResult:FileCheckResult;
begin
  if not FCreateFromFile then //启动Excel,打开一个空Excel表格
  begin
    try
      FExcel := CreateOLEObject('Excel.Application');
      if FExcel.WorkBooks.Count = 0 then
        FWorkBook := FExcel.WorkBooks.Add
      else
        FWorkBook := FExcel.WorkBooks[1];
        //FWorkSheet := FWorkBook.WorkSheets.Add;
      if FExcel.Sheets.Count = 0 then FWorkSheet := FWorkBook.WorkSheets.Add  //如果没有工作表,则创建一个
      else //FWorkSheet := FExcel.ActiveSheet;//否则使用当前工作表
        FWorkSheet := FExcel.worksheets[1];//否则使用当前工作簿第一个工作表
      FWorkSheet.Activate;
      //FWorkSheet := FExcel.WorkBooks[1].Sheets[1];
      FExcelCreated := True;
    except
      MessageDlg('打开Exce失败,请确定您的机器里已安装MicrosoftExcel后,再使用本功能！',mtError,[mbOk],0);;
      FExcelCreated := False;
    end;
  end
  else //根据FFileName指定的文件名,打开文件
  begin
    myFileCheckResult := FileCheck;
    case myFileCheckResult of
      fcrNotExistend:
      begin
        ShowMessage('指定的文件不存在,无法打开,请重新选择文件!');
      end;
      fcrNotXSLFile:
      begin
        ShowMessage('指定的文件不是合法的Excel格式文件,请重新选择文件!');
      end;
      fcrValidXSL:
      begin
        try
          FExcel := CreateOLEObject('Excel.Application');
          FWorkBook := FExcel.WorkBooks.Open(FFileName);

          if FExcel.Sheets.Count = 0 then FWorkSheet := FWorkBook.WorkSheets.Add  //如果没有工作表,则创建一个
          else //FWorkSheet := FExcel.ActiveSheet;//否则使用当前工作表
          FWorkSheet := FExcel.worksheets[1];//否则使用当前工作簿第一个工作表
          //FWorkSheet := FExcel.WorkBooks[1].Sheets[1];
          FWorkSheet.Activate;
          FExcelCreated := True;
        except
          MessageDlg('打开文件失败,可能是您的电脑没有安装Excel软件,请先安装Excel软件！',mtError,[mbOk],0);;
          FExcelCreated := False;
        end;
      end;  
    end;
  end;  
end;

destructor TOLEExcel.Destroy;
begin
  FCellFont.Free;
  FTitleFont.Free;
  try
    FExcel.Quit;
  finally
    FExcel := Unassigned;
  end;
  inherited Destroy;
end;

procedure TOLEExcel.SetExcelCellFont(var Cell: Variant);
begin
  if FIgnoreFont then exit;
  with FCellFont do
  begin
    Cell.Font.Name := Name;
    Cell.Font.Size := Size;
    Cell.Font.Color := Color;
    Cell.Font.Bold := fsBold in Style;
    Cell.Font.Italic := fsItalic in Style;
    Cell.Font.UnderLine := fsUnderline in Style;
    Cell.Font.Strikethrough := fsStrikeout in Style;
  end;
end;

procedure TOLEExcel.SetExcelTitleFont(var Cell: Variant);
begin
  if FIgnoreFont then exit;
  with FTitleFont do
  begin
    Cell.Font.Name := Name;
    Cell.Font.Size := Size;
    Cell.Font.Color := Color;
    Cell.Font.Bold := fsBold in Style;
    Cell.Font.Italic := fsItalic in Style;
    Cell.Font.UnderLine := fsUnderline in Style;
    Cell.Font.Strikethrough := fsStrikeout in Style;
  end;
end;


procedure TOLEExcel.SetVisible(DoShow: Boolean);
begin
  if not FExcelCreated then exit;
  if DoShow then
    FExcel.Visible := True
  else
    FExcel.Visible := False;
end;

function TOLEExcel.GetCell( ARow,ACol: Integer): string;
begin
  if not FExcelCreated then exit;
  result := FWorkSheet.Cells[ARow, ACol];
end;

procedure TOLEExcel.SetCell(ACol, ARow: Integer; const Value: string);
var
  Cell: Variant;
begin
  if not FExcelCreated then exit;
  Cell := FWorkSheet.Cells[ARow, ACol];
  SetExcelCellFont(Cell);
  Cell.Value := Value;
end;


function TOLEExcel.GetDateCell(ACol, ARow: Integer): TDateTime;
begin
  if not FExcelCreated then
  begin
    result := 0;
    exit;
  end;
  result := StrToDateTime(FWorkSheet.Cells[ARow, ACol]);
end;

procedure TOLEExcel.SetDateCell(ACol, ARow: Integer; const Value: TDateTime);
var
  Cell: Variant;
begin
  if not FExcelCreated then exit;
  Cell := FWorkSheet.Cells[ARow, ACol];
  SetExcelCellFont(Cell);
  Cell.Value := '''' + DateTimeToStr(Value);
end;

function TOLEExcel.IsCreated: Boolean;
begin
  result := FExcelCreated;
end;

[Jack_Yin]

街上面

procedure TOLEExcel.SetTitleFont(NewFont: TFont);
begin
  if NewFont <> FTitleFont then
    FTitleFont.Assign(NewFont);
end;

procedure TOLEExcel.SetCellFont(NewFont: TFont);
begin
  if NewFont <> FCellFont then
    FCellFont.Assign(NewFont);
end;

procedure TOLEExcel.GetTableColumnName(const Table: TTable; var Cell: Variant);
var
  Col: integer;
begin
  for Col := 0 to Table.FieldCount - 1 do
    begin
      Cell := FWorkSheet.Cells[1, Col + 1];
      SetExcelTitleFont(Cell);
      Cell.Value := Table.Fields[Col].FieldName;
    end;
end;

procedure TOLEExcel.TableToExcel(const Table: TTable);
var
  Col, Row: LongInt;
  Cell: Variant;
begin
  if not FExcelCreated then exit;
  if Table.Active = False then exit;

  GetTableColumnName(Table, Cell);
  Row := 2;
  with Table do
    begin
      first;
      while not EOF do
        begin
          for Col := 0 to FieldCount - 1 do
            begin
              Cell := FWorkSheet.Cells[Row, Col + 1];
              SetExcelCellFont(Cell);
              Cell.Value := Fields[Col].AsString;
            end;
          next;
          Inc(Row);
        end;
    end;
end;


procedure TOLEExcel.GetQueryColumnName(const Query: TQuery; var Cell: Variant);
var
  Col: integer;
begin
  for Col := 0 to Query.FieldCount - 1 do
    begin
      Cell := FWorkSheet.Cells[1, Col + 1];
      SetExcelTitleFont(Cell);
      Cell.Value := Query.Fields[Col].FieldName;
    end;
end;


procedure TOLEExcel.QueryToExcel(const Query: TQuery);
var
  Col, Row: LongInt;
  Cell: Variant;
begin
  if not FExcelCreated then exit;
  if Query.Active = False then exit;

  GetQueryColumnName(Query, Cell);
  Row := 2;
  with Query do
    begin
      first;
      while not EOF do
        begin
          for Col := 0 to FieldCount - 1 do
            begin
              Cell := FWorkSheet.Cells[Row, Col + 1];
              SetExcelCellFont(Cell);
              Cell.Value := Fields[Col].AsString;
            end;
          next;
          Inc(Row);
        end;
    end;
end;

procedure TOLEExcel.GetFixedCols(const StringGrid: TStringGrid; var Cell: Variant);
var
  Col, Row: LongInt;
begin
  for Col := 0 to StringGrid.FixedCols - 1 do
    for Row := 0 to StringGrid.RowCount - 1 do
      begin
        Cell := FWorkSheet.Cells[Row + 1, Col + 1];
        SetExcelTitleFont(Cell);
        Cell.Value := StringGrid.Cells[Col, Row];
      end;
end;

procedure TOLEExcel.GetFixedRows(const StringGrid: TStringGrid; var Cell: Variant);
var
  Col, Row: LongInt;
begin
  for Row := 0 to StringGrid.FixedRows - 1 do
    for Col := 0 to StringGrid.ColCount - 1 do
      begin
        Cell := FWorkSheet.Cells[Row + 1, Col + 1];
        SetExcelTitleFont(Cell);
        Cell.Value := StringGrid.Cells[Col, Row];
      end;
end;

procedure TOLEExcel.GetStringGridBody(const StringGrid: TStringGrid; var Cell: Variant);
var
  Col, Row, x, y: LongInt;
begin
  Col := StringGrid.FixedCols;
  Row := StringGrid.FixedRows;
  for x := Row to StringGrid.RowCount - 1 do
    for y := Col to StringGrid.ColCount - 1 do
      begin
        Cell := FWorkSheet.Cells[x + 1, y + 1];
        SetExcelCellFont(Cell);
        Cell.Value := StringGrid.Cells[y, x];
      end;
end;

procedure TOLEExcel.StringGridToExcel(const StringGrid: TStringGrid);
var
  Cell: Variant;
begin
  if not FExcelCreated then exit;
  GetFixedCols(StringGrid, Cell);
  GetFixedRows(StringGrid, Cell);
  GetStringGridBody(StringGrid, Cell);
end;

procedure TOLEExcel.SaveToExcel(const FileName: string);
begin
  if not FExcelCreated then exit;
  FWorkSheet.SaveAs(FileName);
  //FExcel.Application.quit;
  //FExcel:=Unassigned;
end;

procedure Register;
begin
  RegisterComponents('OleExcel', [TOLEExcel]);
end;

function TOLEExcel.GetRepRange(x, y: integer): String;{将(x,y)坐标形式改为Excel区域(A1:B1)形式}
var
  fX,fY:string;
begin   
  if y<=0 then  fX:='A';
  if  y<=26 then  fX := chr(64+y);
  if y>26 then  fX:=chr(64+(y div 26))+chr(64+(y mod 26));

  fY:=IntToStr(x);
  Result:=fX+fY;
end;

procedure TOLEExcel.CellMerge(x1, y1, x2, y2: integer);{合并指定单元格}
Var
  RepSpace:String;
begin
  if not FExcelCreated then exit;
  RepSpace:=GetRepRange(x1,y1)+':'+GetRepRange(x2,y2);
  FExcel.Range[RepSpace].Select;
  FExcel.Selection.Merge;
end;

procedure TOLEExcel.SetRepLine(x1,x2,y1,y2:Integer);{加边框线}
Var   
  RepSpace:String;
begin
  if not FExcelCreated then exit;
  RepSpace:=GetRepRange(x1,y1)+':'+GetRepRange(x2,y2);
  FExcel.ActiveSheet.Range[RepSpace].Borders.LineStyle:=xlContinuous;
end;

[Jack_Yin]

还有

procedure TOLEExcel.CellWrite(RepData: String; x, y: Integer);
begin
  if not FExcelCreated then exit;
  FExcel.cells(x,y):=RepData;
end;

procedure TOLEExcel.CellFormat(x1, y1, x2, y2: integer);{指定单元格格式}
Var   
  RepSpace:String;
begin
  if not FExcelCreated then exit;
  RepSpace:=GetRepRange(x1,y1)+':'+GetRepRange(x2,y2);
  FExcel.Range[RepSpace].Select;
  FExcel.Selection.NumberFormat :='G/通用格式';
  FExcel.Selection.Font.Bold:=True;
  FExcel.Selection.HorizontalAlignment:=3; //水平方向对齐方式:居中
end;
procedure TOLEExcel.CellGS(x1, y1, x2, y2, f: integer); {灵活单元格格式}
Var   
  RepSpace:String;
begin
  if not FExcelCreated then exit;
  RepSpace:=GetRepRange(x1,y1)+':'+GetRepRange(x2,y2);
  FExcel.Range[RepSpace].Select;
  FExcel.Selection.NumberFormat :='G/通用格式';
  FExcel.Selection.HorizontalAlignment:=f;//水平方向对齐方式:居中
end;

procedure TOLEExcel.CreatRepSheet(SheetName: String; PageSize,PageLay: Integer);
{给当前工作表重命名、进行页面设置}
begin
  if not FExcelCreated then exit;
  FExcel.ActiveSheet.Name:=SheetName; //重命名当前工作表
  //设置页面
  if PageSize=1 then FExcel.ActiveSheet.PageSetup.PaperSize:=xlPaperA3; //纸张大小:A3
  if PageSize=2 then FExcel.ActiveSheet.PageSetup.PaperSize:=xlPaperA4; //纸张大小   :A4
  if PageSize=3 then FExcel.ActiveSheet.PageSetup.PaperSize:=xlPaperB5; //纸张大小   :B5
  if PageLay=1  then FExcel.ActiveSheet.PageSetup.Orientation:=xlportrait; //页面放置方向：纵向
  if PageLay=2  then FExcel.ActiveSheet.PageSetup.Orientation:=xlLandscape;//页面放置方向：横向
    
  //设置页宽自动适应   
  FExcel.ActiveSheet.PageSetup.Zoom := False;
  FExcel.ActiveSheet.PageSetup.FitToPagesWide := 1;
  FExcel.ActiveSheet.PageSetup.FitToPagesTall := False;   
    
  //设置页眉、页脚(即：页标题、页号)   
  FExcel.ActiveSheet.PageSetup.RightFooter := '打印时间:   '+'&D   &T';
  FExcel.ActiveSheet.PageSetup.CenterFooter:= '第&''&P&''页，共&''&N&''页';   
    
  //设置页边距:   
  FExcel.ActiveSheet.PageSetup.TopMargin:=1.5/0.035;   
  FExcel.ActiveSheet.PageSetup.BottomMargin:=1.5/0.035;   
  FExcel.ActiveSheet.PageSetup.LeftMargin:=1/0.035;   
  FExcel.ActiveSheet.PageSetup.RightMargin:=1/0.035;   
  FExcel.ActiveSheet.PageSetup.HeaderMargin:=0.5/0.035;   
  FExcel.ActiveSheet.PageSetup.FooterMargin:=0.5/0.035;   
    
  //设置页面对齐方式   
  FExcel.ActiveSheet.PageSetup.CenterHorizontally := True;          //页面水平居中
  //FExcel.ActiveSheet.PageSetup.CenterVertically := True;          //页面垂直居中
    
  //设置整体字体格式   
  FExcel.Cells.Font.Name:='宋体';//字体
  FExcel.Cells.Font.Size:=12;//字号
  FExcel.Cells.RowHeight:=16;//行高
  FExcel.Cells.VerticalAlignment:=2;//垂直方向对齐方式:居中   
end;

procedure TOLEExcel.SetAddMess(H_Mess1, H_Mess2, H_Mess3, F_Mess1, F_Mess2,F_Mess3: String);
//用户自定义页眉、页脚（即：页标题、页号）
begin
  if not FExcelCreated then exit;
  FExcel.ActiveSheet.PageSetup.LeftHeader   :=  H_Mess1;
  FExcel.ActiveSheet.PageSetup.CenterHeader :=  H_Mess2;
  FExcel.ActiveSheet.PageSetup.RightHeader  :=  H_Mess3;
end;

procedure TOLEExcel.SetRepBody(x, ch: Integer; cw: Double; cf: String); //设置整体各列数据格式
begin
  if not FExcelCreated then exit;
  FExcel.ActiveSheet.Columns[x].ColumnWidth:=cw;  //列宽
  FExcel.ActiveSheet.Columns[x].NumberFormat:=Cf; //单元格数据格式
  FExcel.ActiveSheet.Columns[x].HorizontalAlignment:=ch;//水平方向对齐方式
end;

procedure TOLEExcel.CreatTitle(TitleName: String; y: Integer);{设置标题}
Var
  RepSpace:String;
begin
  if not FExcelCreated then exit;
  CellMerge(1,1,1,y);
  FExcel.cells(1,1) :=  TitleName;
  RepSpace  :=  'A1'  + ':' + GetRepRange(1,y);
  FExcel.Range[RepSpace].Select;
  FExcel.Selection.NumberFormat :='G/通用格式';
  FExcel.Selection.Font.Size:=22;
  FExcel.Selection.Font.Name:='黑体';
  FExcel.Selection.Font.Bold:=True;
  FExcel.Selection.HorizontalAlignment:=3;             //水平方向对齐方式:居中
  FExcel.Rows[1].RowHeight:=28;   
end;

function TOLEExcel.FileCheck: FileCheckResult; //检查文件
begin
  if not (FileExists(FFileName)) then
  begin
    Result := fcrNotExistend;
    Exit;
  end
  else
  begin
    if UpperCase(ExtractFileExt(FFileName))<> '.XLS' then Result := fcrNotXSLFile
    else Result := fcrValidXSL;
  end;

end;

procedure TOLEExcel.SetCaption(ACaption: string);
begin
  if not FExcelCreated then exit;
  FExcel.Caption := ACaption;
end;

function TOLEExcel.GetCapiton: string;
begin
  if not FExcelCreated then exit;
  Result := FExcel.Caption;
end;

procedure TOLEExcel.CreatSubHead(SubTitle: array of String);{设置常规子表头}
Var   
  i,j:Integer;
begin
  if not FExcelCreated then exit;
  j:=0;
  for i:=Low(SubTitle) to High(SubTitle)   do
  begin
    Inc(j);
    FExcel.cells(2,j):=SubTitle[i];
  end;
end;

procedure TOLEExcel.SubHeadFormat(y, r: Integer);{设置子表头格式}
Var
  RepSpace:String;
  n:Integer;
begin
  if not FExcelCreated then exit;
  RepSpace:='A2'+':'+GetRepRange(1+r,y);
  FExcel.Range[RepSpace].Select;
  FExcel.Selection.NumberFormat   :='G/通用格式';
  FExcel.Selection.HorizontalAlignment:=3;//表头水平对齐方式:居中
  FExcel.Selection.Font.Bold:=True;
  for n:=1 to r do
  begin
    FExcel.Rows[1+n].RowHeight:=18;
    SetRepLine(1+n,y,1+n,y);
  end;
end;

procedure TOLEExcel.DTSubHeadGS(x, y, r: Integer);{设置动态子表头格式}
Var
  RepSpace:String;
  n:Integer;
begin
  if not FExcelCreated then exit;
  RepSpace:=GetRepRange(x,1)+':'+GetRepRange(x+r-1,y);
  FExcel.Range[RepSpace].Select;
  FExcel.Selection.NumberFormat   :='G/通用格式';   
  FExcel.Selection.HorizontalAlignment:=3;                 //表头水平对齐方式:居中
  FExcel.Selection.Font.Bold:=True;   
  for n:=0 to r-1 do
  begin
    FExcel.Rows[x+n].RowHeight:=18;
    SetRepLine(x+n,y,x+n,y);
  end;
end;

procedure TOLEExcel.WriteData(RepData: String; x, y:Integer;flag: Integer = 0);{写数据}
begin
  if not FExcelCreated then exit;
  if flag=1 then //flag = 1 表示写入日期型数据
    FExcel.cells(x,y):=StrToDate(RepData)
  elsea
  FExcel.cells(x,y):=RepData;
end;

procedure TOLEExcel.RepPageBreak(x, y, r: Integer);//分页、复制表头
Var   
  RepSpace:String;
  n:Integer;
begin
  if not FExcelCreated then exit;
  FExcel.ActiveSheet.Rows[x].PageBreak   :=   1;
  RepSpace:='A1'+':'+GetRepRange(r+1,y);
  FExcel.ActiveSheet.Range[RepSpace].Copy;
  RepSpace:='A'+IntToStr(x);
  FExcel.ActiveSheet.Range[RepSpace].PasteSpecial;
  FExcel.Rows[x].RowHeight:=28;
  for n:=2 to r do
    FExcel.Rows[x+n].RowHeight:=18;
end;

procedure TOLEExcel.RepSaveAs(FileName: String);
{保存为*.xls文件}   
begin
  if not FExcelCreated then exit;
  try
    FWorkBook.saveas(FileName);
  except
    MessageDlg('不能访问文件，请关闭Microsoft Excel后再运行本程序！',mtError,[mbOk],0);
  end;
end;

procedure TOLEExcel.RepPrivew;{打印预览当前工作簿的当前工作表}
begin
  if not FExcelCreated then exit;
  FExcel.ActiveSheet.PrintPreview;
end;

function TOLEExcel.GetRowCount: Integer;
begin
  if not FExcelCreated then Result := 0
  else Result := FWorkSheet.UsedRange.Rows.Count;
end;

end.

[kampan]

楼上的兄弟真够全的

[dwtrace]

我是要调用EXCEL中的宏啊，上面的都没有说到～～～？？？

[de410]

delphi 调用 Excel 宏

我的理解宏就是函数,只要我能调用VBA的函数就算是调用Excel宏.
最近很长时间研究如何用delphi调用Excel宏,找了很多资料，大多是讲如何调用Excel，有好几种方式，但真正讲宏的很少，我现在把我的资料共享一下，省得今后有想了解这方面内容的兄弟姐妹们少走弯路。：
1、加载activex和vbide97单元，其中vbide97具体路径在C:\Program Files\Borland\Delphi5\Ocx\Servers下

{动态加载宏除了的几种方法:V.CodeModule.AddFromString
V.CodeModule.AddFromFile
V.CodeModule.InsertLines
还有一些方法在vbide97.pas里面都可以找到
}
其中V:_VBComponent;类型

我在 UseExcel单元中加了AddExcelMaro这个函数，可以直接调用。

下面是UseExcel.pas 其中是msgboxVBA的一个函数。

unit UseExcel; //将数据导入Excel的单元
{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}
Interface
Uses DBGrids,SysUtils,StdCtrls,ExtCtrls,Windows,Dialogs,Classes,Forms,Excel97,
Controls,DB,OleServer,activex,vbide97;
{------------------------------------------------------------------------------}
procedure PutOutData(DBN:TDataSet; PXM:TDBGrid);
//PXM=TDBGrid控件显示的内容, DBN=TDBGrid控件连接的TDataSet.
//将PXM显示的内容输出数据到Excel
procedure AddExcelMaro();
{------------------------------------------------------------------------------}
{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}
Implementation
Var ExApp:TExcelApplication; ExlWb:TExcelWorkbook; ExWS:TExcelWorksheet;
{******************************************************************************}
Function CreateExcel:Boolean;
Begin
ExApp:=TExcelApplication.Create(Forms.Application);//这里也很关键，在vbide里Application也是一个类型，所以只能在他前面加上Forms.，否则编译报错。
ExApp.ConnectKind:=ckNewInstance;
ExlWb:=TExcelWorkbook.Create(Forms.Application);
ExlWb.ConnectKind:=ckRunningOrNew;
ExWS:=TExcelWorksheet.Create(Forms.Application);
ExWS.ConnectKind:=ckRunningOrNew;
CreateExcel:=True;
Try
ExApp.Connect;
Except
CreateExcel:=False;
ExApp.Free;
ExlWb.Free;
ExWS.Free;
End;
End;
{******************************************************************************}
Function CheckPrtXM(DBN:TDataSet; DBField:String):Boolean; Var X:Integer;
Begin
CheckPrtXM:=False;
For X:=0 To DBN.FieldDefs.Count-1 Do If DBField=DBN.FieldDefs[X].Name Then
Begin
CheckPrtXM:=True;
Exit;
End;
End;
{******************************************************************************}
Procedure WriteToExcel(DBN:TDataSet; PXM:TDBGrid); Var X,Y,Row,Column:Integer;

Begin
ExApp.Visible[0]:=True;
ExApp.Caption:='编辑打印数据';
ExApp.Workbooks.Add(Null,0);
ExlWb.ConnectTo(ExApp.Workbooks[1]);
ExWS.ConnectTo(ExlWb.Worksheets[1] as _Worksheet);
Y:=1;
For X:=0 To PXM.Columns.Count-1 Do If (PXM.Columns[X].Visible=True)
And (CheckPrtXM(DBN,PXM.Columns[X].FieldName)=True) Then
Begin
ExWS.Cells.Item[1,Y]:=PXM.Columns[X].Title.Caption;
Y:=Y+1;
End;
DBN.Last;
DBN.First;
Row:=2;
While Not DBN.Eof Do
Begin
Column:=1;
For X:=0 To PXM.Columns.Count-1 Do If(PXM.Columns[X].Visible=True)
And(CheckPrtXM(DBN,PXM.Columns[X].FieldName)=True) Then
Begin
ExWS.Cells.Item[Row,Column]:=
DBN.FieldByName(PXM.Columns[X].FieldName).AsString;
Column:=column+1;
End;
DBN.Next;
Row:=Row+1;
End;
End;

procedure AddExcelMaro();
var
V:_VBComponent;
vArg1, vArg2, vArg3, vArg4, vArg5, vArg6, vArg7, vArg8, vArg9, vArg10,
vArg11, vArg12, vArg13, vArg14, vArg15, vArg16, vArg17, vArg18, vArg19, vArg20,
vArg21, vArg22, vArg23, vArg24, vArg25, vArg26, vArg27, vArg28, vArg29, vArg30: OLEVariant;
begin
vArg1:= EmptyParam; vArg2:= EmptyParam; vArg3:= EmptyParam; vArg4:= EmptyParam;
vArg5:= EmptyParam; vArg6:= EmptyParam; vArg7:= EmptyParam; vArg8:= EmptyParam;
vArg9:= EmptyParam; vArg10:= EmptyParam; vArg11:= EmptyParam; vArg12:= EmptyParam;
vArg13:= EmptyParam; vArg14:= EmptyParam; vArg15:= EmptyParam; vArg16:= EmptyParam;
vArg17:= EmptyParam; vArg18:= EmptyParam; vArg19:= EmptyParam; vArg20:= EmptyParam;
vArg21:= EmptyParam; vArg22:= EmptyParam; vArg23:= EmptyParam; vArg24:= EmptyParam;
vArg25:= EmptyParam; vArg26:= EmptyParam; vArg27:= EmptyParam; vArg28:= EmptyParam;
vArg29:= EmptyParam; vArg30:= EmptyParam;
V:=ExlWb.VBProject.VBComponents.Add(TOleEnum($00000001));
V.name:='Module';
// V.CodeModule.AddFromString('Public Sub test() '+#13+'msgbox("test") '+#13+'end sub');
{动态加载宏除了的几种方法:V.CodeModule.AddFromString
V.CodeModule.AddFromFile
V.CodeModule.InsertLines
}
ExApp.Visible[0] := True;
ExApp.Run('test',vArg1, vArg2, vArg3, vArg4, vArg5, vArg6, vArg7, vArg8, vArg9, vArg10,
vArg11, vArg12, vArg13, vArg14, vArg15, vArg16, vArg17, vArg18, vArg19, vArg20,
vArg21, vArg22, vArg23, vArg24, vArg25, vArg26, vArg27, vArg28, vArg29, vArg30);
ExApp.Disconnect;
ExApp.Quit;
ExApp.Free;
ExlWb.Free;
ExWS.Free;


end;


{******************************************************************************}
procedure PutOutData(DBN:TDataSet; PXM:TDBGrid);
Begin
If CreateExcel=False Then ShowMessage('系统中未安装Excel') Else
Begin
WriteToExcel(DBN,PXM);


End;
End;
{******************************************************************************}
end.

[Jack_Yin]

[Quote=引用 6 楼 dwtrace 的回复:]
我是要调用EXCEL中的宏啊，上面的都没有说到～～～？？？
[/Quote]
所谓的宏不过是一段VBA代码,如果楼主看了我给的代码,在看看Excel的VBA帮助的话,就知道如何加VBA代码翻译成Delphi代码了.
个人认为会见VBA代码翻译成Delphi代码才是王道,因为以后要想用Delphi控制Excel就轻松了.
以下是Delphi调用Excel代码(为经测试)

var
  AExcel: Variant;
begin
  AExcel := CreateOleObject('Excel.Application');
  AExcel.WorkBooks.Open(sFileName);  //sFileName: Excel文件名
  AExcel.Run(宏名);                  //Run: 调用执行Excel宏

Excel的VBA帮助,关于宏的部分
运行一个宏或者调用一个函数。该方法可用于运行用 Visual Basic 或 Microsoft Excel 宏语言编写的宏，或者运行 DLL 或 XLL 中的函数。

expression.Run(Macro, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9, Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29, Arg30)
expression 必需。该表达式返回一个 Application 对象。

Macro Variant 类型，可选。所要运行的宏。既可以是一个带有宏名的字符串，也可以是指示此函数所在位置的 Range 对象，或者是一个已注册的 DLL (XLL) 函数的注册号。如果使用字符串，将在当前工作表环境中对此字符串求值。

Arg1-Arg30 Variant 类型，可选。传递给函数的参数。

说明
此方法不可使用命名参数，参数必须通过位置进行传递。

Run 方法返回被调用宏的任何返回值。如果将对象作为参数传递给宏，该对象将转换为相应的值（通过对对象应用 Value 属性）。这意味着不能用 Run 方法将对象传递给宏。

示例
本示例示范如何调用宏表“Mycustom.xlm”（必须先打开此宏表〕中定义的宏函数 My_Func_Sum。此函数带两个数值型参数（此例中为 1 和 5）。

mySum = Application.Run("MYCUSTOM.XLM!My_Func_Sum", 1, 5)
MsgBox "Macro result: " & mySum

[au8988]

正好要用到。非常感谢！