来自：Dk108 时间：00-12-20 16:37:37 ID:421921
如何利用ole automation 在excel中新建文件？
---------------------------------
来自：lq123 时间：00-12-24 22:45:00 ID:424201
Template := EmptyParam;
nid:=1;
ExcelApplication1.Workbooks.Add(Template, Nid);
excel表在DELPHI中的操作有很多。你查些源程序用吧。贴一段给你吧。
直接用 OLE 读取 EXCEL 文档。
procedure TForm1.Button1Click(Sender: TObject);
var ExcelApp,MyWorkBook: OLEVariant;
i,j: Integer;
begin
try
ExcelApp:=CreateOleObject('Excel.Application');
MyWorkBook:=CreateOleobject('Excel.Sheet');
except
application.Messagebox('无法打开Xls文件，请确认已 经安装EXCEL.','',
mb_OK+mb_IconStop);
Exit;
end;
//ExcelApp.Visible := true;
MyworkBook:= ExcelApp.workBooks.Open(ExtractFileDir(Application.ExeName)
+ '\' + Edit1.Text + '.xls');
for i := 3 to 9 do begin
//Read a row into table
table1.Append;
table1.FieldByName('Name').AsString := MyWorkBook.WorkSheets[1].Cells[i,1].Value;
table1.FieldByName('Size').AsString := MyWorkBook.WorkSheets[1].Cells[i,2].Value;
table1.FieldByName('Weight').AsString := MyWorkBook.WorkSheets[1].Cells[i,3].Value;
table1.FieldByName('Area').AsString := MyWorkBook.WorkSheets[1].Cells[i,4].Value;
end;
//showmessage(MyWorkBook.WorkSheets[1].Columns[1].numberformat);
//showmessage(MyWorkBook.WorkSheets[1].Columns[2].numberformat);
ExcelApp:=Unassigned; //释放VARIANT变量
end;
--------------------------------------------------------------------------------
来自：arm 时间：00-12-25 16:07:28 ID:424796
unit armconst;
interface
CONST
xlContinuous = 1;
xlInsideHorizontal = 12;
xlInsideVertical = 11;
xlDiagonalDown = 5;
xlDiagonalUp = 6;
xlEdgeBottom = 9;
xlEdgeLeft = 7;
xlEdgeRight = 10;
xlEdgeTop = 8;
xlNone = -4142;
//pager size
type
TPaperSize=(xlPaper10x14,
xlPaper11x17,
xlPaperA3,
xlPaperA4,
xlPaperA4Small,
xlPaperA5,
xlPaperB4,
xlPaperB5,
xlPaperCsheet,
xlPaperDsheet,
xlPaperEnvelope10,
xlPaperEnvelope11,
xlPaperEnvelope12,
xlPaperEnvelope14,
xlPaperEnvelope9,
xlPaperEnvelopeB4,
xlPaperEnvelopeB5,
xlPaperEnvelopeB6,
xlPaperEnvelopeC3,
xlPaperEnvelopeC4,
xlPaperEnvelopeC5,
xlPaperEnvelopeC6,
xlPaperEnvelopeC65,
xlPaperEnvelopeDL,
xlPaperEnvelopeItaly,
xlPaperEnvelopeMonarch,
xlPaperEnvelopePersonal,
xlPaperEsheet,
xlPaperExecutive,
xlPaperFanfoldLegalGerman,
xlPaperFanfoldStdGerman,
xlPaperFanfoldUS,
xlPaperFolio,
xlPaperLedger,
xlPaperLegal,
xlPaperLetter,
xlPaperLetterSmall,
xlPaperNote,
xlPaperQuarto,
xlPaperStatement,
xlPaperTabloid,
xlPaperUser
);
const
PaperSizeMetrics : array[xlPaper10x14..xlPaperUser] of Integer =
( $00000010,
$00000011,
$00000008,
$00000009,
$0000000A,
$0000000B,
$0000000C,
$0000000D,
$00000018,
$00000019,
$00000014,
$00000015,
$00000016,
$00000017,
$00000013,
$00000021,
$00000022,
$00000023,
$0000001D,
$0000001E,
$0000001C,
$0000001F,
$00000020,
$0000001B,
$00000024,
$00000025,
$00000026,
$0000001A,
$00000007,
$00000029,
$00000028,
$00000027,
$0000000E,
$00000004,
$00000005,
$00000001,
$00000002,
$00000012,
$0000000F,
$00000006,
$00000003,
$00000100);
implementation
end.
{*******************************************************}
{ }
{ Arm Software TArmExcel Package }
{ TArmExcel Unit }
{ }
{ Copyright (C) 2000 Arm Software }
{ 作者 ：宫雨 }
{ 地址:dht@www.bjpeu.edu.cn }
{*******************************************************}
{TArmExcel 用EXCEL做报表,
1。设置纸张、页眉页脚、网格线
2。导出数据集的数据-（对部分字段）求和
3。可以选择工作表，打印预览
4。像STRINGGrid一样使用CellS属性
5。有ONExportProgress事件与用户交互
2000-09-14 修改代码结构}
unit ArmExcel;
interface
uses
Windows,comobj,Messages,SysUtils,db,Classes,Forms,armconst;
type
//用于页眉页脚
TReportTitle=class(TPersistent)
private
FLeft:string;
FCenter:string;
FRight:string;
public
published
property Left:string read Fleft write Fleft;
property Center:string read Fcenter write Fcenter;
property Right:string read FRight write FRight;
end;
//export
TExportOptions=class(TPersistent)
private
FShowSum:boolean;
FDataset:Tdataset;
FDrawGrid:boolean;
FSaveFile:boolean;
FShowExcel:boolean;
FShowFieldName:boolean;
FSaveFileName:string;
FCellColOffset,FCellRowOffset:integer;
FSumFields:TStrings;
procedure SetSumFields(const Value: TStrings);
public
constructor create;
destructor Destroy;override;
published
//user interface
property DrawGrid:boolean read FDrawGrid write FDrawGrid;
property ShowFieldName:boolean read FShowFieldName write FShowFieldName;
property SaveFileName:string read FSaveFileName write FSaveFileName;
//dataset
property CellColOffset:integer read FCellColOffset write FCellColOffset;//数据集横向偏移量
property CellRowOffset:integer read FCellRowOffset write FCellRowOffset;//数据集竖直偏移量
property SaveFile:boolean read FSaveFile write FSaveFile;
property Dataset:Tdataset read Fdataset write Fdataset; //数据集
property ShowSum:boolean read FShowSum write FShowSum;
property ShowExcel:boolean read FShowExcel write FShowExcel;
property SumFields:TStrings read FSumFields write SetSumFields;
end;
//表格线
TGridBound=class(TPersistent)
private
ftop:integer;
fbottom:integer;
fleft:integer;
fright:integer;
public
published
property top:integer read FTop write Ftop;
property bottom:integer read fbottom write fbottom;
property left:integer read Fleft write fleft;
property Right:integer read FRight write fright;
end;
type
TProgressEvent = procedure(Info: string; Count, Total: Integer) of object;
//
TArmExcel = class(TComponent)
private
msexcel:variant;
wbook:Variant;
wsheet:variant;
FFilename:string;
FPrintTitleRows:STRING;//表头
FHeader,FFooter:TReportTitle;
FExportOptions:TExportOptions;
FGrid:TGridBound;
FShowGrid: boolean;
FDirectPreview:boolean;
Factivesheet:string;
FPagerSize:TPaperSize;
FshowWindows:boolean;
Fclose:boolean;
FOnExportProgress:TProgressEvent;
procedure DrawGrid;
procedure ClearGrid;
procedure PageSetup;
function GetCells(ARow,ACol: Integer): olevariant;
procedure SetCells(ARow,ACol: Integer; const Value: olevariant);
procedure CaculateSum;
procedure SetActiveSheet(const Value: string);
procedure SetShowGrid(const Value: boolean);
procedure SetPrintTitleRows(const Value: STRING);
procedure SetPagerSize(const Value: TPaperSize);
protected
{ Protected declarations }
public
constructor Create(AOwner:TComponent);override;
destructor Destroy; override;
procedure CreateInstance;
procedure FreeExcelInstance;
procedure ExportData;
procedure ShowExcelWindow;
property Cells[ACol,ARow:Integer]: olevariant read GetCells write SetCells;
published
property FileName:string read FFileName write FFileName;//模板文件名
property Header:TReportTitle read Fheader write Fheader;//页眉
property Footer:TReportTitle read FFooter write FFooter; //页脚
property ExportOptions:TExportOptions read FExportOptions write FExportOptions;
property ShowGrid:boolean read FShowGrid write SetShowGrid ; //显示网格
property GridBound:TGridBound read FGrid write FGrid;//网格边界
PROPERTY PrintTitleRows:STRING READ FPrintTitleRows WRITE SetPrintTitleRows;//每页表头
property ActiveSheet:string Read FActiveSheet write SetActiveSheet;//当前工作表
property PaperSize:TPaperSize read FPagerSize write SetPagerSize ; //纸张大小
property DirectPreview:boolean read FDirectPreview write FDirectPreview; //直接预览
property CloseExcelWhenAppClose:boolean read Fclose write Fclose;//当程序关闭时关闭Excel
property ShowWindowAfterOpen:boolean read FshowWindows write FshowWindows;
//event
property OnExportProgress:TProgressEvent read FOnExportProgress write FOnExportProgress;//进度显示
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('宫雨', [TArmExcel]);
end;
{ TArmExcel }
constructor TArmExcel.create(aowner: TComponent);
begin
inherited Create(AOwner);
Fheader:=TReportTitle.create;
FFooter:=TReportTitle.create;
Fgrid:=TGridBound.create;
FExportOptions:=TExportOptions.Create;
FShowGrid:=False;
FClose:=True;
FDirectPreview:=false;
FPagerSize:=xlPaperA4;
end;
procedure TArmExcel.createinstance;
begin
MsExcel:= CreateOleObject('Excel.Application');
WBook:=MsExcel.Application;
if (filename<>'') and (FileExists(FileName)) then
wbook.workbooks.Open(filename)
else
wbook.workbooks.add;
if activesheet<>'' then
wbook.Sheets[activesheet].Select;
WSheet:=WBook.ActiveSheet;
if showgrid then
DrawGrid;
PageSetup;
if FshowWindows then
ShowExcelWindow;
end;
destructor TArmExcel.Destroy;
begin
if fclose then
freeEXCElinstance;
Fheader.Free;
FFooter.Free;
Fgrid.Free;
FExportOptions.Free;
inherited Destroy;
end;
procedure TArmExcel.drawgrid;
VAR
ATXT:STRING;
begin
if Varisempty(wsheet) then
exit;
WITH GridBound DO
BEGIN
ATXT:=chr(64+left)+inttostr(top)+':'+chr(64+RIGHT)+inttostr(bottom);
WSheet.Range[ATXT].Borders[xlDiagonalDown].LineStyle:= xlNone;
WSheet.Range[ATXT].Borders[xlDiagonalUp].LineStyle:=xlNone;
WSheet.Range[ATXT].Borders[xlEdgeLeft].LineStyle:=xlContinuous;
WSheet.Range[ATXT].Borders[xlEdgeTop].LineStyle:=xlContinuous;
WSheet.Range[ATXT].Borders[xlEdgeBottom].LineStyle:=xlContinuous;
WSheet.Range[ATXT].Borders[xlEdgeRight].LineStyle:=xlContinuous;
WSheet.Range[ATXT].Borders[xlInsideVertical].LineStyle:=xlContinuous;
WSheet.Range[ATXT].Borders[xlInsideHorizontal].LineStyle:=xlContinuous;
END;
end;
procedure TArmExcel.FreeExcelInstance;
begin
if not varisempty(wbook) then
begin
Wbook.DisplayAlerts:=False;
Wbook.quit;
WBook:= UnAssigned;
end;
end;
function TArmExcel.GetCells(ARow,ACol: Integer): olevariant;
begin
if not varisempty(wsheet) then
result:=wsheet.cells[arow,acol].value;
end;
procedure TArmExcel.PageSetup;
begin
WSheet.PageSetup.PrintTitleRows:=PrintTitleRows;
if Header.left<>'' then
wsheet.pagesetup.LeftHeader:=Header.left;
if Header.right<>'' then
wsheet.pagesetup.RightHeader:=Header.RIGHT;
if Header.Center<>'' then
wsheet.pagesetup.CenterHeader:=Header.CENTER;
if FOOTER.left<>'' then
wsheet.pagesetup.LeftFooter:=Footer.left;
if FOOTER.right<>'' then
wsheet.pagesetup.RightFooter:=Footer.RIGHT;
if FOOTER.center<>'' then
wsheet.pagesetup.CenterFooter:=Footer.CENTER;
wsheet.pagesetup.PaperSize:=PaperSizeMetrics[PaperSize];
if (DirectPreview) then
wbook.ActiveWindow.SelectedSheets.PrintPreview;
end;
procedure TArmExcel.SetCells(ARow,ACol:Integer; const Value: olevariant);
begin
if not varisempty(wsheet) then
wsheet.cells[AROw,ACol].value:=value;
end;
procedure TArmExcel.ShowExcelWindow;
begin
WBook.Visible:=True;
end;
procedure TArmExcel.ExportData;
const
info='进度：%D/%D';
var
i,j,index:integer;
SavePlace: TBookmark;
begin
if ExportOptions.dataset=nil then
exit;
if not ExportOptions.dataset.active then
exit;
with ExportOptions.dataset,ExportOptions do
begin
SavePlace := GetBookmark;
disablecontrols;
first;
i:=1;
if ShowFieldName then
begin
for j:=0 to fieldcount-1 do
wsheet.cells[1+CellColOffset,j+1+CellRowOffset]:=fields[j].DisplayLabel;
i:=i+1;
end;
while not eof do
begin
for j:=0 to fieldcount-1 do
if fields[j].datatype in [Ftfloat,ftSmallint,ftInteger,ftWord,ftCurrency] then
wsheet.cells[i+CellColOffset,j+1+CellRowOffset]:=fields[j].asfloat
else
wsheet.cells[i+CellColOffset,j+1+CellRowOffset]:=fields[j].asstring;
next;
if Assigned(OnExportProgress) then
if ShowFieldName then
OnExportProgress(format(info,[i,RecordCount+1]),I,RecordCount)
else
OnExportProgress(format(info,[i,RecordCount]),I,RecordCount);
Application.ProcessMessages;
i:=i+1;
end;
if ShowSum and (Sumfields.Count<>0) then
begin
for j:=0 to fieldcount-1 do
if Tstringlist(sumfields).find(fields[j].FieldName,index) then
begin
if fields[j].datatype in [Ftfloat,ftSmallint,ftInteger,ftWord,ftCurrency] then
if ShowFieldName then
wsheet.Cells[i+CellColOffset,j+1+CellRowOffset]:='=sum('+chr(j+CellColOffset+65)
+inttostr(CellRowOffset+2)+':'+chr(j+CellColOffset+65)+inttostr(CellRowOffset+1+recordcount)+')'
else
wsheet.Cells[i+CellColOffset,j+1+CellRowOffset]:='=sum('+chr(j+CellColOffset+65)
+inttostr(CellRowOffset+1)+':'+chr(j+CellColOffset+65)+inttostr(CellRowOffset+recordcount)+')';
end;
end;
GotoBookmark(SavePlace);
FreeBookmark(SavePlace);
enablecontrols;
if DrawGrid then
begin
GridBound.top:=CellRowOffset+1;
if ShowFieldName then
GridBound.bottom:=RecordCount+CellRowOffset+1
else
GridBound.bottom:=RecordCount+CellRowOffset;
GridBound.left:=1+CellColOffset;
GridBound.Right:=CellColOffset+FieldCount;
self.DrawGrid;
end;
if SaveFile and (SaveFileName<>'')then
wbook.activeworkbook.saveas(SaveFileName);
if ShowExcel then
ShowExcelWindow;
end;
end;
procedure TArmExcel.CaculateSum;
begin
with ExportOptions,ExportOptions.Dataset do
begin
end;
end;
procedure TArmExcel.SetActiveSheet(const Value: string);
begin
FActiveSheet:= Value;
if (FActiveSheet<>'') and (Not Varisempty(wbook)) then
wbook.Sheets[activesheet].Select;
end;
procedure TArmExcel.SetShowGrid(const Value: boolean);
begin
FShowGrid := Value;
if FShowGrid then
DrawGrid
else
ClearGrid;
end;
procedure TArmExcel.ClearGrid;
VAR
ATXT:STRING;
begin
if Varisempty(wsheet) then
exit;
WITH GridBound DO
BEGIN
ATXT:=chr(64+left)+inttostr(top)+':'+chr(64+RIGHT)+inttostr(bottom);
WSheet.Range[ATXT].Borders[xlDiagonalDown].LineStyle:= xlNone;
WSheet.Range[ATXT].Borders[xlDiagonalUp].LineStyle:=xlNone;
WSheet.Range[ATXT].Borders[xlEdgeLeft].LineStyle:=xlNone;
WSheet.Range[ATXT].Borders[xlEdgeTop].LineStyle:=xlNone;
WSheet.Range[ATXT].Borders[xlEdgeBottom].LineStyle:=xlNone;
WSheet.Range[ATXT].Borders[xlEdgeRight].LineStyle:=xlNone;
WSheet.Range[ATXT].Borders[xlInsideVertical].LineStyle:=xlNone;
WSheet.Range[ATXT].Borders[xlInsideHorizontal].LineStyle:=xlNone;
END;
end;
procedure TArmExcel.SetPrintTitleRows(const Value: STRING);
begin
FPrintTitleRows := Value;
if not Varisempty(wsheet) then
WSheet.PageSetup.PrintTitleRows:=PrintTitleRows;
end;
procedure TArmExcel.SetPagerSize(const Value: TPaperSize);
begin
FPagerSize := Value;
if not Varisempty(wsheet) then
wsheet.pagesetup.PaperSize:=PaperSizeMetrics[PaperSize];
end;
{ TExportOptions }
constructor TExportOptions.create;
begin
inherited create;
FSumFields:=TStringlist.Create;
end;
destructor TExportOptions.Destroy;
begin
FSumFields.Free;
inherited Destroy;
end;
procedure TExportOptions.SetSumFields(const Value: TStrings);
begin
if Value = FSumFields then
Exit;
FSumFields.Assign(Value);
end;
end.