Delphi控制Excel的经验(二) 分享

来源：互联网发布：ios 虚拟定位软件编辑：程序博客网时间：2024/05/16 01:47

(三)   使用Delphi   控制Excle二维图

在Form中分别放入ExcelApplication,   ExcelWorkbook和ExcelWorksheet

var   asheet1,achart,   range:variant;

1）选择当第一个工作薄第一个工作表

asheet1:=ExcelApplication1.Workbooks[1].Worksheets[1];

2）增加一个二维图

achart:=asheet1.chartobjects.add(100,100,200,200);

3）选择二维图的形态

achart.chart.charttype:=4;

4）给二维图赋值

series:=achart.chart.seriescollection;

range:=sheet1!r2c3:r3c9;

series.add(range,true);

　

5）加上二维图的标题

achart.Chart.HasTitle:=True;

achart.Chart.ChartTitle.Characters.Text:=’   Excle二维图’

6）改变二维图的标题字体大小

achart.Chart.ChartTitle.Font.size:=6;

7）给二维图加下标说明

achart.Chart.Axes(xlCategory,   xlPrimary).HasTitle   :=   True;

achart.Chart.Axes(xlCategory,   xlPrimary).AxisTitle.Characters.Text   :=   '下标说明';

8）给二维图加左标说明

achart.Chart.Axes(xlValue,   xlPrimary).HasTitle   :=   True;

achart.Chart.Axes(xlValue,   xlPrimary).AxisTitle.Characters.Text   :=   '左标说明';

9）给二维图加右标说明

achart.Chart.Axes(xlValue,   xlSecondary).HasTitle   :=   True;

achart.Chart.Axes(xlValue,   xlSecondary).AxisTitle.Characters.Text   :=   '右标说明';

10）改变二维图的显示区大小

achart.Chart.PlotArea.Left   :=   5;

achart.Chart.PlotArea.Width   :=   223;

achart.Chart.PlotArea.Height   :=   108;

11）给二维图坐标轴加上说明

achart.chart.seriescollection[1].NAME:='坐标轴说明';


Top

4 楼kerisyml（魂之利刃）回复于 2003-07-04 15:45:54 得分 70unit   U_Report;

interface
uses     Windows,   SysUtils,   Messages,   Dialogs,   Classes,   Forms,   OleCtnrs,   OleServer,   Excel97,   ComObj;

Const         ReNo=23;           //一页显示的记录数
Const         MAX=35;           //最大的数组个数

Var
      ExlApp:OleVariant;
      ExlBook:OleVariant;

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

      procedure   RepCreat;                                                               //创建OLE对象(Excel   Application与WorkBook)
      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,flag:Integer);                                                       //写入数据
      procedure   RepPageBreak(x,y,r:Integer);                                                                             //分页、复制表头
      procedure   RepSaveAs(FileName:String);                                                                             //保存为*.xls文件
      procedure   RepPrivew(FileName:String);                                                                                                   //预览
      procedure   RepQuit;                                                                                                                               //退出Excel
      procedure   RepDestroy;                                                                                                             //非正常退出Excel

implementation

function   GetRepRange(x,y:integer):string;
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   CellMerge(x1,y1,x2,y2:integer);
{合并指定单元格}
Var
      RepSpace:String;
begin
      RepSpace:=GetRepRange(x1,y1)+':'+GetRepRange(x2,y2);
      ExlApp.Range[RepSpace].Select;
      ExlApp.Selection.Merge;
end;{CellMerge}

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

end;{CellFormat}

procedure   CellGS(x1,y1,x2,y2,f:integer);
{灵活单元格格式}
Var
      RepSpace:String;
begin
      RepSpace:=GetRepRange(x1,y1)+':'+GetRepRange(x2,y2);
      ExlApp.Range[RepSpace].Select;
      ExlApp.Selection.NumberFormat   :='G/通用格式';
      ExlApp.Selection.HorizontalAlignment:=f;             //水平方向对齐方式:居中
end;{CellGS}

procedure   SetRepLine(x,y:Integer);
{加边框线}
Var
      RepSpace:String;
begin
      RepSpace:=GetRepRange(x,1)+':'+GetRepRange(x,y);
      ExlApp.ActiveSheet.Range[RepSpace].Borders.LineStyle:=xlContinuous;
end;{SetRepLine}

procedure   CellWrite(RepData:   String;   x,y:Integer);
{单元格写数据}
begin
      ExlApp.cells(x,y):=RepData;
end;{CellWrite}

procedure   RepCreat;
{创建Excel对象}
begin
      try
          ExlApp:=CreateOLEObject('Excel.Application');
          ExlBook:=CreateOLEObject('Excel.Sheet');
          ExlApp.Visible   :=False;//   True;
          ExlApp.DisplayAlerts   :=   False;
      except
          MessageDlg('您的机器里未安装Microsoft   Excel！',   mtError,   [mbOk],   0);
          Exit;
      end;{try}
end;{RepCreat}
procedure   CreatRepSheet(SheetName:String;PageSize,PageLay:Integer);
{新建Excel工作簿、进行页面设置}
begin
      {新建Excel工作簿}
      if   ExlApp.WorkBooks.Count<1   then
      begin
          ExlBook:=ExlApp.Workbooks.Add;             //ExlBook:=ExlApp.WorkBooks[1].WorkSheets[1];
          ExlApp.ActiveSheet.Name:=SheetName;
      end;{if}

      {进行页面设置}

以上是怎么不用空间而调用EXCEL的
很方便的！
//设置页面
      if   PageSize=1   then
          ExlApp.ActiveSheet.PageSetup.PaperSize:=xlPaperA3;             //纸张大小   :A3
      if   PageSize=2   then
          ExlApp.ActiveSheet.PageSetup.PaperSize:=xlPaperA4;             //纸张大小   :A4
      if   PageSize=3   then
          ExlApp.ActiveSheet.PageSetup.PaperSize:=xlPaperB5;             //纸张大小   :B5
      if   PageLay=1   then
          ExlApp.ActiveSheet.PageSetup.Orientation:=xlportrait;       //页面放置方向：纵向
      if   PageLay=2   then
          ExlApp.ActiveSheet.PageSetup.Orientation:=xlLandscape;     //页面放置方向：横向

      //设置页宽自动适应
      ExlApp.ActiveSheet.PageSetup.Zoom   :=   False;
      ExlApp.ActiveSheet.PageSetup.FitToPagesWide   :=   1;
      ExlApp.ActiveSheet.PageSetup.FitToPagesTall   :=   False;

      //设置页眉、页脚(即：页标题、页号)
      ExlApp.ActiveSheet.PageSetup.RightFooter:='打印时间:   '+'&D   &T';
      ExlApp.ActiveSheet.PageSetup.CenterFooter:='第&''&P&''页，共&''&N&''页';
Top

5 楼kerisyml（魂之利刃）回复于 2003-07-04 15:46:15 得分 0 //设置页边距:
      ExlApp.ActiveSheet.PageSetup.TopMargin:=1.5/0.035;
      ExlApp.ActiveSheet.PageSetup.BottomMargin:=1.5/0.035;
      ExlApp.ActiveSheet.PageSetup.LeftMargin:=1/0.035;
      ExlApp.ActiveSheet.PageSetup.RightMargin:=1/0.035;
      ExlApp.ActiveSheet.PageSetup.HeaderMargin:=0.5/0.035;
      ExlApp.ActiveSheet.PageSetup.FooterMargin:=0.5/0.035;

      //设置页面对齐方式
      ExlApp.ActiveSheet.PageSetup.CenterHorizontally:=True;           //页面水平居中
//     ExlApp.ActiveSheet.PageSetup.CenterVertically   :=True;             //页面垂直居中

      //设置整体字体格式
      ExlApp.Cells.Font.Name:='宋体';                                       //字体
      ExlApp.Cells.Font.Size:=12;                                               //字号
      ExlApp.Cells.RowHeight:=16;                                           //行高
      ExlApp.Cells.VerticalAlignment:=2;                               //垂直方向对齐方式:居中
end;{CreatRepSheet}

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

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

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

procedure   CreatSubHead(SubTitle:   Array   of   String);
{设置常规子表头}
Var
      i,j:Integer;
begin
      j:=0;
      for     i:=Low(SubTitle)   to   High(SubTitle)   do
      begin
          Inc(j);
          ExlApp.cells(2,j):=SubTitle[i];
      end;
end;{CreatRepHead}

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

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

procedure   WriteData(RepData:   String;   x,y,flag:Integer);   //写入数据
{写数据}
begin
      if   flag=1   then
          ExlApp.cells(x,y):=StrToDate(RepData)
      else
          ExlApp.cells(x,y):=RepData;
end;{WriteDate}

procedure   RepPageBreak(x,y,r:Integer);       //X：分页处行数，Y：列数，R：子表头总共的行数
//分页、复制表头
Var
      RepSpace:String;
      n:Integer;
begin
      ExlApp.ActiveSheet.Rows[x].PageBreak   :=   1;
      RepSpace:='A1'+':'+GetRepRange(r+1,y);
      ExlApp.ActiveSheet.Range[RepSpace].Copy;
      RepSpace:='A'+IntToStr(x);
      ExlApp.ActiveSheet.Range[RepSpace].PasteSpecial;
      ExlApp.Rows[x].RowHeight:=28;
      for   n:=2   to   r   do
          ExlApp.Rows[x+n].RowHeight:=18;
end;{RepPageBreak}

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

procedure   RepPrivew(FileName:String);
{预览}
begin
      RepCreat;
      ExlApp.Visible   :=True;
      try
          ExlApp.workBooks.Open(FileName);
          ExlApp.Workbooks[1].WorkSheets[1].PrintPreview;
      finally
          ExlApp.Quit;
          ExlApp:=Unassigned;
          //ExlApp:='';
      end;{try}
end;{RepPrivew}

procedure   RepQuit;
{退出Excel}
begin
    ExlBook.Close;
    ExlApp.Quit;               //退出Excel   Application
    ExlApp:=Unassigned;     //释放VARIANT变量
end;{RepQuit}

procedure   RepDestroy;
{非正常退出Excel}
begin
      if   Not   VarIsEmpty(ExlApp)   then
          RepQuit;
end;{RepDestroy}

end.

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//颜色