fastreport2.5预览的报表怎样导出excel(50)

  • 主题发起人 主题发起人 fhuibo
  • 开始时间 开始时间
F

fhuibo

Unregistered / Unconfirmed
GUEST, unregistred user!
我放了frOLEExcelExport 和 frCSVExport 导出后都不是我要的效果,请问怎么把fastreport预览的数据完整的导出excel,就是说导出excel后用fastreport 打印和导出的excel打印都是一样的效果
 
没想到还有和一样在用fastreport 2.5的!其实 用自带导出excel导出是乱七八糟的,很多报表工具都是一样的!我写一个通用导出工具,从dbgrideh1中导出excel!注:导出excel就是填数据,没有什么难的楼主可以参考一下:procedure TForm_main.DOExcel(dbgrideh1:TDBGridEh;RptTitl:string); var ExcelID,Excelbook: Variant; MaxTitCount,i,j,k,Cnt,y:integer; Titl,CelVale:string; cValue,oldValue:String; saveBK:TBookmark;//滚动begin if not VarIsEmpty(ExcelID) then begin ExcelID.quit; ExcelID:=Unassigned; Excelbook:=Unassigned; end; Screen.Cursor :=crHourGlass ; ExcelID := CreateOleObject( 'Excel.Application' ); if VarIsEmpty( ExcelID) then begin showmessage('没有安装 Excel 电子表格,不能导入!'); abort; end; ExcelID.workbooks.add; ExcelID.workbooks[1].workSheets[1].name:='Jason'; Excelbook:=ExcelID.workbooks[1].workSheets['Jason']; //表头处理 oldValue:=''; MaxTitCount:=0; with DBGridEh1 do //NO 1 begin for i:=0 to Columns.Count -1 do begin Titl:=Columns.Title.Caption+'|'; j:=0; K:=1; while Pos('|', Titl) > 0 do begin cValue:=copy(Titl,j+1,Pos('|', Titl)-1-j); j:=Pos('|', Titl); Titl[Pos('|', Titl)]:='/'; Excelbook.Cells[k,i+1]:=cValue ; k:=k+1; end; if k>MaxTitCount then MaxTitCount:=k-1; end; //纵向合并 for i:=1 to Columns.Count do begin oldValue:=Excelbook.Cells[1,i] ; for k:=2 to MaxTitCount do begin cValue:= Excelbook.Cells[k,i] ; if (oldValue = cValue) or (cValue='') then begin Excelbook.Cells[k,i]:=''; Excelbook.Range[ Excelbook.Cells[k-1,i], Excelbook.Cells[k,i]].Merge ; end; oldValue:=cValue; end; end; //横合并 if MaxTitCount<2 then MaxTitCount:=2; for k:=1 to MaxTitCount do begin Excelbook.Rows[inttostr(k)+':1'].HorizontalAlignment := xlCenter ; Excelbook.Rows[inttostr(k)+':1'].VerticalAlignment := xlCenter ; oldValue:=Excelbook.Cells[k,1] ; for i:=2 to Columns.Count do begin cValue:=Excelbook.Cells[k,i] ; if (oldValue = cValue) and (cValue<>'') then begin Excelbook.Cells[k,i]:=''; Excelbook.Range[Excelbook.Cells[k,i-1],Excelbook.Cells[k,i]].Merge ; end; oldValue:=cValue; end; end; //数据处理 Cnt:=Columns.Count; if Cnt<2 then Cnt:=2 ;//2003.01.20要至少导入2列 with DataSource.DataSet do begin saveBK := GetBookmark; { Save current record position }//在导入中看不到DBGRID移动 DisableControls; First; for i:=0 to Columns.Count -1 do if columns.Visible then begin if Columns.Field.DataType in [ftInteger] then Excelbook.Range[Excelbook.Cells[MaxTitCount+1,i+1],Excelbook.Cells[RecordCount+8,i+1]].NumberFormatLocal:= '0' else if Columns.Field.DataType in [ftUnknown,ftString] then Excelbook.Range[Excelbook.Cells[MaxTitCount+1,i+1],Excelbook.Cells[RecordCount+8,i+1]].NumberFormatLocal:= '@' else if Columns.Field.DataType in [ftCurrency,ftFloat,ftBCD] then begin Excelbook.Range[Excelbook.Cells[MaxTitCount+1,i+1],Excelbook.Cells[RecordCount+8,i+1]].HorizontalAlignment := xlRight ; Excelbook.Range[Excelbook.Cells[MaxTitCount+1,i+1],Excelbook.Cells[RecordCount+8,i+1]].VerticalAlignment := xlCenter ; Excelbook.Range[Excelbook.Cells[MaxTitCount+1,i+1],Excelbook.Cells[RecordCount+8,i+1]].NumberFormatLocal := '#,###0.000;-#,###0.000'; //'¥#,##0.00;¥-#,##0.00'; 2008-6-20 update end; end; y:=1; //表头下几行开始导入 while not eof do begin for i:=0 to Columns.Count -1 do if columns.Visible then begin CelVale:=Columns.DisplayText; if celvale='0' then //2008-6-20 update celvale:=''; if uppercase(celVale) = 'FALSE' then celVale:='否'; if uppercase(celVale) = 'TRUE' then celVale:='是'; Excelbook.Cells[y+MaxTitCount,i+1]:=celVale; end; next; y:=Y+1; end; GotoBookmark(saveBK); { Restore original record position} Freebookmark(saveBK); EnableControls; end; // 加合计 if (DBGridEh1.FooterRowCount >0) and (DBGridEh1.SumList.Active=true) then for i:=0 to DBGridEh1.Columns.Count -1 do begin Excelbook.Cells[y+MaxTitCount,i+1]:=dbgrideh1.GetFooterValue(0,dbgrideh1.Columns); end; y:=Y+1; //制表 k:=y+MaxTitCount+1; //+1为合计值表行 Excelbook.Range[Excelbook.Cells[2,1],Excelbook.Cells[k-1,Cnt]].Font.Size :=12; Excelbook.Range[Excelbook.Cells[1,1],Excelbook.Cells[k-2,Cnt]].Borders[xlDiagonalDown].LineStyle := xlNone; Excelbook.Range[Excelbook.Cells[1,1],Excelbook.Cells[k-2,Cnt]].Borders[xlDiagonalUp].LineStyle := xlNone; Excelbook.Range[Excelbook.Cells[1,1],Excelbook.Cells[k-2,Cnt]].Borders[xlEdgeLeft].LineStyle := xlContinuous; Excelbook.Range[Excelbook.Cells[1,1],Excelbook.Cells[k-2,Cnt]].Borders[xlEdgeTop].LineStyle := xlContinuous; Excelbook.Range[Excelbook.Cells[1,1],Excelbook.Cells[k-2,Cnt]].Borders[xlEdgeBottom].LineStyle := xlContinuous; Excelbook.Range[Excelbook.Cells[1,1],Excelbook.Cells[k-2,Cnt]].Borders[xlEdgeRight].LineStyle := xlContinuous; Excelbook.Range[Excelbook.Cells[1,1],Excelbook.Cells[k-2,Cnt]].Borders[xlInsideVertical].LineStyle := xlContinuous; Excelbook.Range[Excelbook.Cells[1,1],Excelbook.Cells[k-2,Cnt]].Borders[xlInsideHorizontal].LineStyle := xlContinuous; Excelbook.Range[Excelbook.Cells[1,1],Excelbook.Cells[k-2,Cnt]].Rows.AutoFit ; Excelbook.Range[Excelbook.Cells[1,1],Excelbook.Cells[k-2,Cnt]].Columns.AutoFit; // 表未处理 //表头标题 Excelbook.Cells[1,1].EntireRow.Insert; Excelbook.Rows['1:1'].HorizontalAlignment := xlCenter ; Excelbook.Rows['1:1'].VerticalAlignment := xlCenter ; Excelbook.Range[Excelbook.Cells[1,1],Excelbook.Cells[1,cnt]].Merge ; Excelbook.Cells[1,1]:=RptTitl; //标题 Excelbook.Range[Excelbook.Cells[1,1],Excelbook.Cells[1,cnt]].Font.Name:='明细体'; Excelbook.Range[Excelbook.Cells[1,1],Excelbook.Cells[1,cnt]].Font.FontStyle :='粗体'; Excelbook.Range[Excelbook.Cells[1,1],Excelbook.Cells[1,cnt]].Font.Size :=14; end; //NO 1 Screen.Cursor :=crDefault ; ExcelID.Visible := True; end;
 
学习了。
 

Similar threads

回复
0
查看
813
不得闲
D
回复
0
查看
867
DelphiTeacher的专栏
D
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
836
DelphiTeacher的专栏
D
后退
顶部