有很多类似的问题了。再贴一次吧。
procedure TForm1.Button5Click(Sender: TObject);
var
ExcelApp,MyWorkBook,mysheet:Variant;
i :byte;
s: string;
begin
try
ExcelApp:=CreateOleObject('Excel.Application');
MyWorkBook:=CreateOleobject('Excel.Sheet');
//? MyWorkBook:=ExcelApp.workbooks.open('C:/Book1.xls');
except
on Exception do raise exception.Create('无法打开Xls文件,请确认已 经安装EXCEL')
end;
ExcelApp.Visible := true;
//? mysheet:=MyWorkBook.WorkSheets[1].name;
MyworkBook:=ExcelApp.workBooks.Add;
//在此处插入读数据库及写Excel文档的代码
//其中写Excel文档的关键语句如下:
Myworkbook.worksheets[1].range['A1
1'].Merge(True);
Myworkbook.worksheets[1].range['A1
2'].HorizontalAlignment := $FFFFEFF4;
MyWorkBook.WorkSheets[1].Cells[1,1].Value := 'YourTitle';
i := 2;
MyWorkBook.WorkSheets[1].Cells[i,1].Value := 'yourCaption1';
MyWorkBook.WorkSheets[1].Cells[i,2].Value := 'yourCaption2';
MyWorkBook.WorkSheets[1].Cells[i,3].Value := 'yourCaption3';
MyWorkBook.WorkSheets[1].Cells[i,4].Value := 'yourCaption4';
Myworkbook.worksheets[1].Range['A1
2'].Font.Color := clBlue;
Myworkbook.worksheets[1].Range['A1
1'].Font.Name := '隶书';
Myworkbook.worksheets[1].Range['A1
1'].Font.Size := 18;
i := 3;
table1.close;
table1.open;
table1.First;
while not table1.eof do begin
MyWorkBook.WorkSheets[1].Cells[i,1].Value := table1.FieldByName('au_id').AsString;
MyWorkBook.WorkSheets[1].Cells[i,2].Value := table1.FieldByName('royaltyper').AsInteger;
MyWorkBook.WorkSheets[1].Cells[i,3].Value := table1.FieldByName('au_ord').AsInteger;
MyWorkBook.WorkSheets[1].Cells[i,4].Value := table1.FieldByName('title_id').AsString;
Inc(i);
table1.Next
end;
ExcelApp.Visible := true;
s := 'A3
'+ IntToStr(i-1);
//设定字体. 栏宽等
s := 'A1
'+ IntToStr(i-1);
Myworkbook.worksheets[1].Columns[1].ColumnWidth := 20;
Myworkbook.worksheets[1].Columns[4].ColumnWidth := 25;
Myworkbook.worksheets[1].Rows[1].RowHeight := 50;
Myworkbook.worksheets[1].Rows[1].VerticalAlignment := $FFFFEFF4;
Myworkbook.worksheets[1].Range
.Font.Name := '仿宋';
s := 'A2'+ IntToStr(i-1);
Myworkbook.worksheets[1].Range.Borders.LineStyle := 1;
//页面设置
MyworkBook.WorkSheets[1].PageSetup.CenterHorizontally := true;
Myworkbook.worksheets[1].pagesetup.PrintTitleRows := 'A1';
//不能设置 papersize 属性, 原因不明
//MyworkBook.WorkSheets[1].PageSetup.PaperSize := $9;
try
MyWorkBook.saveas('c:/' + Edit1.Text + '.xls');
MyWorkBook.close;
except //当存为一个已有的文档而又不覆盖时将
MyWorkBook.close; //产生一个例外
end;
ExcelApp.Quit;
ExcelApp:=Unassigned; //释放VARIANT变量
end;