unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,comobj, ExtCtrls;type TForm1 = class(TForm) Button1: TButton; Button2: TButton; Button3: TButton; Button4: TButton; Button5: TButton; CheckBox1: TCheckBox; OpenDialog1: TOpenDialog; SaveDialog1: TSaveDialog; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure Button5Click(Sender: TObject); procedure Button3Click(Sender: TObject); private { Private declarations } public { Public declarations } end;var Form1: TForm1; v: Variant; Sheet: Variant;implementation{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject); begin try v:=CreateOleObject('Excel.Application'); v.Visible:=CheckBox1.Checked; if MessageDlg('新建还是打开:是否新建Excel 文件?',mtConfirmation,[mbYes,mbNo],0)=mrYes then begin v.WorkBooks.Add; //新建Excel 文件 v.WorkBooks[1].WorkSheets[1].name:='电脑报';//第一页标题 v.WorkBooks[1].WorkSheets[2].name:='编程乐园'; v.WorkBooks[1].WorkSheets[3].name:='都来看呀'; Sheet:=v.WorkBooks[1].WorkSheets[1]; Sheet.Cells[1,1]:='好看';//单元格内容 Sheet.Cells[1,2]:='确实'; Sheet.Cells[2,1]:='我喜欢'; end else if OpenDialog1.Execute then v.WorkBooks.Open(Opendialog1.FileName) else exit; except showmessage('初始化Excel失败,可能没装Excel,或者其他错误;请重新再试。'); v.DisplayAlerts:=false;//是否提示存盘 v.Quit;//退出Excel exit; end; Application.Restore; Application.BringToFront; end;//~~~~~~~~~~~~~~~~~~~~~~~~~Excel 文档格式设置~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ procedure TForm1.Button2Click(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'];//the space of unit From A2 to G2 Range.Merge;//combine the unit spaces Range.Rows.RowHeight:=50;//locate the height of the row of the unit space Range.Borders.LineStyle:=1;//add the border casement Range.Columns[2].ColumnWidth:=12;//locate the width of the columns Range.FormulaR1C1:='合并区'; Range.HorizontalAlignment:=3;//xlCenter(the Horizontall alignment pattern Range.VerticalAlignment:=2;//xlCenter(the Vertical alignment pattern Range.Characters.Font.Name:='宋体'; Range.Characters.Font.FontStyle:='加粗'; Range.Characters.Font.Size:=15; Range.Characters.Font.OutlineFont:=False; Range.Characters.Font.ColorIndex:=0; except showmessage('初始化Excel失败,可能没装Excel,或者其他错误;请重新再试。'); v.DisplayAlerts:=false; v.Quit; exit; end; end; end;//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~关闭Excel 并退出~~~~~~~~~~~~~~~~~~~~~~~~~~~~ procedure TForm1.Button4Click(Sender: TObject); begin try if not varIsEmpty(v) then begin if SaveDialog1.Execute then begin if FileExists(SaveDialog1.FileName) then if MessageDlg(Format('OK to OverWrite %s',[SaveDialog1.FileName]),mtconfirmation,mbYesNoCancel,0)<>idYes then exit; v.WorkBooks[1].saveas(SaveDialog1.FileName); end else begin if OpenDialog1.FileName<>'' then begin v.WorkBooks[1].saved:=true; v.WorkBooks[1].Close(true,'C:\untitled.xls'); end; end; v.quit; v:=Unassigned; end; finally Close; end; end;//~~~~~~~~~~~~~~~~~~~退出系统~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ procedure TForm1.Button5Click(Sender: TObject); begin v.WorkBooks[1].Close(true,'C:\untitled.xls');//exit and hand out the name of file //v.disPlayAlert:=true; v.quit; v:=Unassigned; close; end;//~~~~~~~~~~~~~~~~~~~~Excel 打印页面设置及打印预览~~~~~~~~~~~~~~~~~~~~~~~~~~ procedure TForm1.Button3Click(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';//the head of page sheet.PageSetup.PrintTitleColumns:=''; Sheet.PageSetup.LeftFooter:='注:页脚'+'总共&N页'+'——第&P页';//the footer of page Sheet.PageSetup.LeftMargin:=30;//locate the instance of the border Sheet.PageSetup.RightMargin:=30; Sheet.PageSetup.TopMargin:=30; Sheet.PageSetup.BottomMargin:=50; //Sheet.PageSetup.PrintQuality:=400; //分辨率(根据打印机确定) Sheet.PageSetup.CenterHorizontally:=true;//if the center and horizon Sheet.PageSetup.CenterVertically:=true;//if the center and verticality Sheet.PageSetup.Orientation:=2;//the sideling print Sheet.PageSetup.Draft:=False;//if draft Sheet.PageSetup.FirstPageNumber:=1; Sheet.pageSetup.BlackAndWhite:=true;//the draft of black and white Sheet.PageSetup.Zoom:=100;//shorten or extend Sheet.PrintPreview;//preview except showmessage('初始化Excel失败,可能没装Excel,或者其他错误;请重新再试。'); v.DisplayAlerts:=false; v.Quit; exit; end; end; end;end.
先感谢 yuhouyangguang(雨后阳光) 兄,烦请再贴出关于WORD文档的相关操作的代码。
我说 aquadp(阿凯) 啊,你也懒了点吧??自己研究一下好吧??
procedure TMain.btnTestClick(Sender: TObject); function DSetToExcel(const DSet: TDataSet; ExcelFile: String): OLEVARIANT; var ExcelApp, WorkBook: OLEVARIANT; i: Integer; Row: Integer; begin Screen.Cursor := crHourGlass; try ExcelApp := CreateOleObject('Excel.Application'); WorkBook := CreateOleObject('Excel.Sheet'); except Screen.Cursor := crDefault; ShowMessage(' 信息:您尚未安装EXCEL或不可用! '); Exit; end; WorkBook := ExcelApp.WorkBooks.Add; Row := 2; for i := 1 to DSet.FieldCount do begin ExcelApp.Cells(Row,i) := DSet.Fields[i - 1].DisplayLabel end; Row := 3; while (DSet.Active) and (not DSet.Eof) do begin for i := 1 to DSet.FieldCount do begin ExcelApp.Cells(Row,i) := DSet.Fields[i - 1].AsString; end; Inc(Row); DSet.Next; end; WorkBook.SaveAs(ExcelFile); WorkBook.Close; ExcelApp.Quit; ExcelApp := Unassigned; Screen.Cursor := crDefault; end; begin DSetToExcel(tblICK,'C:\DEMO.XLS'); end;
在学学VBA(就是office里的宏代码),然后把VBA以delphi的格式写,就差不多了,具体比较麻烦,可以完成office组件的全部功能
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,comobj, ExtCtrls;type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
CheckBox1: TCheckBox;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;
v: Variant;
Sheet: Variant;implementation{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
begin
try
v:=CreateOleObject('Excel.Application');
v.Visible:=CheckBox1.Checked;
if MessageDlg('新建还是打开:是否新建Excel 文件?',mtConfirmation,[mbYes,mbNo],0)=mrYes then
begin
v.WorkBooks.Add; //新建Excel 文件
v.WorkBooks[1].WorkSheets[1].name:='电脑报';//第一页标题
v.WorkBooks[1].WorkSheets[2].name:='编程乐园';
v.WorkBooks[1].WorkSheets[3].name:='都来看呀';
Sheet:=v.WorkBooks[1].WorkSheets[1];
Sheet.Cells[1,1]:='好看';//单元格内容
Sheet.Cells[1,2]:='确实';
Sheet.Cells[2,1]:='我喜欢';
end
else
if OpenDialog1.Execute then
v.WorkBooks.Open(Opendialog1.FileName)
else
exit;
except
showmessage('初始化Excel失败,可能没装Excel,或者其他错误;请重新再试。');
v.DisplayAlerts:=false;//是否提示存盘
v.Quit;//退出Excel
exit;
end;
Application.Restore;
Application.BringToFront;
end;//~~~~~~~~~~~~~~~~~~~~~~~~~Excel 文档格式设置~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TForm1.Button2Click(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'];//the space of unit From A2 to G2
Range.Merge;//combine the unit spaces
Range.Rows.RowHeight:=50;//locate the height of the row of the unit space
Range.Borders.LineStyle:=1;//add the border casement
Range.Columns[2].ColumnWidth:=12;//locate the width of the columns
Range.FormulaR1C1:='合并区';
Range.HorizontalAlignment:=3;//xlCenter(the Horizontall alignment pattern
Range.VerticalAlignment:=2;//xlCenter(the Vertical alignment pattern
Range.Characters.Font.Name:='宋体';
Range.Characters.Font.FontStyle:='加粗';
Range.Characters.Font.Size:=15;
Range.Characters.Font.OutlineFont:=False;
Range.Characters.Font.ColorIndex:=0;
except
showmessage('初始化Excel失败,可能没装Excel,或者其他错误;请重新再试。');
v.DisplayAlerts:=false;
v.Quit;
exit;
end;
end;
end;//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~关闭Excel 并退出~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TForm1.Button4Click(Sender: TObject);
begin
try
if not varIsEmpty(v) then
begin
if SaveDialog1.Execute then
begin
if FileExists(SaveDialog1.FileName) then
if MessageDlg(Format('OK to OverWrite %s',[SaveDialog1.FileName]),mtconfirmation,mbYesNoCancel,0)<>idYes then
exit;
v.WorkBooks[1].saveas(SaveDialog1.FileName);
end
else
begin
if OpenDialog1.FileName<>'' then
begin
v.WorkBooks[1].saved:=true;
v.WorkBooks[1].Close(true,'C:\untitled.xls');
end;
end;
v.quit;
v:=Unassigned;
end;
finally
Close;
end;
end;//~~~~~~~~~~~~~~~~~~~退出系统~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TForm1.Button5Click(Sender: TObject);
begin
v.WorkBooks[1].Close(true,'C:\untitled.xls');//exit and hand out the name of file
//v.disPlayAlert:=true;
v.quit;
v:=Unassigned;
close;
end;//~~~~~~~~~~~~~~~~~~~~Excel 打印页面设置及打印预览~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TForm1.Button3Click(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';//the head of page
sheet.PageSetup.PrintTitleColumns:='';
Sheet.PageSetup.LeftFooter:='注:页脚'+'总共&N页'+'——第&P页';//the footer of page
Sheet.PageSetup.LeftMargin:=30;//locate the instance of the border
Sheet.PageSetup.RightMargin:=30;
Sheet.PageSetup.TopMargin:=30;
Sheet.PageSetup.BottomMargin:=50;
//Sheet.PageSetup.PrintQuality:=400; //分辨率(根据打印机确定)
Sheet.PageSetup.CenterHorizontally:=true;//if the center and horizon
Sheet.PageSetup.CenterVertically:=true;//if the center and verticality
Sheet.PageSetup.Orientation:=2;//the sideling print
Sheet.PageSetup.Draft:=False;//if draft
Sheet.PageSetup.FirstPageNumber:=1;
Sheet.pageSetup.BlackAndWhite:=true;//the draft of black and white
Sheet.PageSetup.Zoom:=100;//shorten or extend
Sheet.PrintPreview;//preview
except
showmessage('初始化Excel失败,可能没装Excel,或者其他错误;请重新再试。');
v.DisplayAlerts:=false;
v.Quit;
exit;
end;
end;
end;end.
function DSetToExcel(const DSet: TDataSet; ExcelFile: String): OLEVARIANT;
var
ExcelApp,
WorkBook: OLEVARIANT; i: Integer;
Row: Integer;
begin
Screen.Cursor := crHourGlass; try
ExcelApp := CreateOleObject('Excel.Application');
WorkBook := CreateOleObject('Excel.Sheet');
except
Screen.Cursor := crDefault;
ShowMessage(' 信息:您尚未安装EXCEL或不可用! ');
Exit;
end;
WorkBook := ExcelApp.WorkBooks.Add; Row := 2;
for i := 1 to DSet.FieldCount do
begin
ExcelApp.Cells(Row,i) := DSet.Fields[i - 1].DisplayLabel
end;
Row := 3;
while (DSet.Active) and (not DSet.Eof) do
begin
for i := 1 to DSet.FieldCount do
begin
ExcelApp.Cells(Row,i) := DSet.Fields[i - 1].AsString;
end;
Inc(Row);
DSet.Next;
end;
WorkBook.SaveAs(ExcelFile);
WorkBook.Close;
ExcelApp.Quit;
ExcelApp := Unassigned; Screen.Cursor := crDefault;
end;
begin
DSetToExcel(tblICK,'C:\DEMO.XLS');
end;