使用该函数需要先Use Excel2010
//DataSet导出Excel2010格式 //FileName=待导出的Excel的文件名,不带路径以及后缀;TitleLine1=导出后Excel第一表头,TitleLine2=Excel第二表头;CellsNames=Excel表格中Field的Title名称; //IsOpen=是否马上打开
procedure sysDSetToXlsx(DSet: TADODataSet;FileName,TitleLine1,TitleLine2:String;
CellsNames: TStringList; IsOpen: Boolean = False);
var
ExcelApp: TExcelApplication;
ExcelWorkBook: TExcelWorkbook;
ExcelWorkSheet: TExcelWorksheet;
Range: OleVariant;
I,RecNo: Integer;
TmpPath: string;
begin
try
ExcelApp := TExcelApplication.Create(nil);
ExcelWorkBook := TExcelWorkbook.Create(nil);
ExcelWorkSheet := TExcelWorksheet.Create(nil);
except
msgRaise('没有安装office 2007或以上版本,请安装后再试');
end;
//创建Excel
ExcelApp.Connect;
ExcelApp.Workbooks.Add(null,0);
ExcelWorkBook.ConnectTo(ExcelApp.Workbooks[1]);
ExcelWorkSheet.ConnectTo(ExcelWorkBook.Worksheets[1] as _WorkSheet);
//构造Excel表头
Range := ExcelApp.Range[ExcelWorkSheet.Cells.Item[1,1],ExcelWorkSheet.Cells.Item[2,CellsNames.Count]];
Range.MergeCells := True;
Range.Font.Size := 18;
Range.Font.Bold := True;
Range.HorizontalAlignment := 3; //横向居中,此处如果使用xlCenter报“类Range” 错误
Range.VerticalAlignment := 2; //竖向居中,此处如果使用xlCenter报“类Range” 错误
Range.RowHeight := 40;
Range.Cells[1,1] := TitleLine1; //表头第一行
Range := ExcelApp.Range[ExcelWorkSheet.Cells.Item[3,1],ExcelWorkSheet.Cells.Item[3,CellsNames.Count]];
Range.MergeCells := True; //合并
Range.Font.Size := 10;
Range.Font.Bold := True;
Range.HorizontalAlignment := 4; //同上错误
Range.VerticalAlignment := 2; //同上错误
Range.RowHeight := 20;
Range.Cells[1,1] := TitleLine2; //表头第二行
Range.Cells[3,1].Select; //此处两行代码用于冻结头两行 ExcelApp.ActiveWindow.FreezePanes := True;
for I := 1 to CellsNames.Count do
begin
Range.Cells[2,I] := CellsNames.Names[I-1]; //需与DSet的Fields顺序保持一致
Range.Columns[I].ColumnWidth := CellsNames.Values[CellsNames.Names[I-1]]; //Excel文件中的单元格宽,单位为字符.
end;
RecNo := DSet.RecNo;
DSet.DisableControls;
DSet.First;
while not DSet.Eof do
begin
for I := 1 to CellsNames.Count do
Range.Cells[DSet.RecNo + 2, I] := VarToStr(DSet.Fields[I-1].Value);
DSet.Next;
end;
DSet.RecNo := RecNo;
DSet.EnableControls;
TmpPath := sysGetPath(HInstance) + 'xls\'; //sysGetPath=自定义函数,获取当前路径
if not DirectoryExists(TmpPath) then
ForceDirectories(TmpPath);
ExcelWorkSheet.SaveAs(TmpPath + FileName + '.xlsx');
ExcelWorkSheet.Disconnect;
ExcelWorkBook.Disconnect;
ExcelApp.Quit; //这句比较重要,很多例子中没有这句,关闭后,进程中还是能够发现Excel进程没有关闭
ExcelApp.Disconnect;
FreeAndNil(ExcelWorkSheet);
FreeAndNil(ExcelWorkBook);
FreeAndNil(ExcelApp);
if IsOpen then
sysExecuteFile(TmpPath + FileName + '.xlsx','','',0);
end;
|
请发表评论