哪位有数据导出到excel例子,贴出来看看!!

dovelee 2006-12-18 05:25:13
如题
...全文
348 11 打赏 收藏 转发到动态 举报
写回复
用AI写文章
11 条回复
切换为时间正序
请发表友善的回复…
发表回复
才子鸣 2006-12-21
  • 打赏
  • 举报
回复
給你一個函數!

procedure ExportToExcel(SDBGrid:TDBGrid;ExcelCaption:String;SheetsName:string;
TheTitle:string;TitleSize:Integer;FontBold:Boolean;PrintViewTitle:string);
var
iCount, jCount: Integer;
XLApp: Variant;
begin
Screen.Cursor := crHourGlass;
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
VarClear(XLApp);
end;
if not SDBGrid.DataSource.DataSet.Active then
begin
Screen.Cursor := crDefault;
Exit;
end else begin
try
XLApp := CreateOleObject('Excel.Application');
except
Application.MessageBox(PChar('Excel 無法打開,請檢查您是否安裝了Excel軟體。'),PChar('提示'),MB_OK+MB_ICONERROR) ;
Screen.Cursor := crDefault;
Exit;
end;
end;
XLApp.WorkBooks.Add; //新加工作薄
XLApp.Caption:=ExcelCaption; //工作薄名

XLApp.WorkBooks[1].WorkSheets[1].Name := SheetsName; //表名
XLApp.Cells[1,1].value:=TheTitle; //標題

XLApp.Cells[1,1].Font.Size:=TitleSize; //字體
XLApp.Cells[1,1].Merge;

for iCount := 0 to SDBGrid.Columns.Count - 1 do
begin
XLApp.Cells[2, iCount + 1].Value := SDBGrid.Columns[iCount].Title.Caption;
end;
jCount := 1;
SDBGrid.DataSource.DataSet.First;
while not SDBGrid.DataSource.DataSet.Eof do
begin
for iCount := 0 to SDBGrid.Columns.Count - 1 do
begin
XLApp.cells[jCount + 2, iCount + 1].Value := SDBGrid.Columns[iCount].Field.AsString;
end;
Inc(jCount);
SDBGrid.DataSource.DataSet.Next;
end;
XLApp.ActiveSheet.Rows[2].Font.Bold := FontBold; //粗體
XLApp.ActiveSheet.Rows[2].Font.Color := clBlue; //藍色
XLApp.ActiveSheet.PageSetup.CenterHeader := PrintViewTitle; //打印序覽
XlApp.Visible := True;
Screen.Cursor := crDefault;
end;
winxkm 2006-12-21
  • 打赏
  • 举报
回复

procedure TPrintSQL_Data.PrintSqlDataToExcel(PB: TRzProgressBar);
var
I:integer;
Range,ExcelApp,V:variant;
begin
Try
ExcelApp:=CreateOleObject('Excel.application');
PB.PartsComplete:=0;
Except
MessageDlg('没有安装Office 办公软件Excel!',mtinformation,[MBOK],0);
exit;
End;

try
ExcelApp.WorkBooks.add(Null);
V:=ExcelApp.WorkBooks[1].WorkSheets[1];

//*开始设计标题*/
Range:=V.Range['A1',GetExcelCoulmnCaption(DataSet.Fields.Count)+'1'];
Range.MergeCells:=true;
Range.RowHeight:=24;
Range.HoriZontalAlignMent:=xlCenter;
Range.VerticalAlignMent:=xlCenter;
Range.Font.Name:='新宋体';
Range.Font.size:=16;
Range.Font.FontStyle:='加粗';
Range.Value:=FExcelTitle;
Range.Borders.LineStyle:=xlContinuous; //边框
Range.Borders.Weight:=xlThin;
Range.Borders.ColorIndex:=xlAutomatic;

//显示标题
For i:=0 To DataSet.Fields.Count-1 Do
begin
Range:=V.Range[GetExcelCoulmnCaption(I+1)+'2',GetExcelCoulmnCaption(I+1)+'2'];
Range.RowHeight:=24;
Range.HoriZontalAlignMent:=xlCenter;
Range.VerticalAlignMent:=xlCenter;
Range.Font.Name:='新宋体';
Range.Font.size:=9;
Range.Font.FontStyle:='加粗';
Range.Columns.AutoFit;
Range.Value:=DataSet.Fields[I].FieldName;
Range.Borders.LineStyle:=xlContinuous; //边框
Range.Borders.Weight:=xlThin;
Range.Borders.ColorIndex:=xlAutomatic;
end;
//显示内容
//set
Range:=V.Range['A3',GetExcelCoulmnCaption(DataSet.FieldCount)+IntToStr(DataSet.recordcount+2)];
Range.NumberFormatLocal:= '@';
Range.RowHeight:=20;
Range.HoriZontalAlignMent:=xlCenter;
Range.VerticalAlignMent:=xlCenter;
Range.Borders.LineStyle:=xlContinuous; //边框
Range.Borders.Weight:=xlThin;
Range.Borders.ColorIndex:=xlAutomatic;
Range.Font.Name:='新宋体';
Range.Font.size:=9;
Range.Columns.AutoFit;

PB.TotalParts:=DataSet.RecordCount;
DataSet.First;
While (Not DataSet.Eof) do
begin
For i:=0 To DataSet.Fields.Count-1 Do
begin
Range:=V.Range[GetExcelCoulmnCaption(I+1)+IntToStr(DataSet.RecNo+2),GetExcelCoulmnCaption(I+1)+IntToStr(DataSet.RecNo+2)];
if DataSet.Fields[I].IsNull then
Range.Value:=' '
else
Range.Value:=DataSet.Fields[I].AsString;
Range.Borders.LineStyle:=xlContinuous; //边框
Range.Borders.Weight:=xlThin;
Range.Borders.ColorIndex:=xlAutomatic;
end;
PB.IncPartsByOne;
DataSet.next;
end;

//显示Excel文档界面
ExcelApp.visible:=true;
V.Activate;
finally
//释放接口对象
ExcelApp:=unassigned;
V:= unassigned;
Range:=unassigned;
PB.PartsComplete:=0;
end;
end;

procedure TPrintSQL_Data.SetActive(Value: Boolean);
begin
If Value then
begin
If DataSet.Connection<>nil then
begin
try
With DataSet do
begin
IF Active then Active:=false;
Commandtext:=FSQLString;
Active:=true;
FActive:=Value;
end;
except
on E:Exception do
MessageDlg('查询操作失败!'+#13#10+'异常类:'+E.ClassName+#13#10+'错误信息代码为:'+E.Message,mtinformation,[MBOK],0);
end;
end
else MessageDlg('没有选择数据库连接对象!',mtinformation,[MBOK],0);
end else begin
FActive:=Value;
Fprinting:=False;
end;
end;

procedure TPrintSQL_Data.SetDataSet(Value: TADODataSet);
begin
FDataSet:=Value;
end;

procedure TPrintSQL_Data.SetExcelFileName(Value: string);
begin
FExcelFileName:=Value;
end;


procedure TPrintSQL_Data.SetExcelTitle(Value: TCaption);
begin
FExcelTitle:=value;
end;

procedure TPrintSQL_Data.SetPrinting(Value: boolean);
begin
if Active then
begin
if self.DataSet.Fields.Count>0 then
if Value then
PrintSqlDataToExcel;
end else FPrinting := Value;
end;

procedure TPrintSQL_Data.SetSQLString(Value: string);
begin
FSQLString:=Value;
FActive:=false;
FPrinting:=False;
end;

end.
winxkm 2006-12-21
  • 打赏
  • 举报
回复
具体组件代码如下:
unit PrintSQL_Data;

interface

uses
SysUtils, Classes,Messages, Variants, Graphics, Controls, Forms,
Dialogs,windows,ADODB,ComObj,Excel2000,RzPrgres;

type
TPrintSQL_Data = class(TComponent)
private
{ Private declarations }
FDataSet:TADODataSet;
FActive:Boolean;
FSQLString:string;
FExcelTitle:TCaption;
FPrinting:Boolean;
FExcelFileName:string;
procedure SetSQLString(Value:string);
procedure SetExcelTitle(Value:TCaption);
procedure SetExcelFileName(Value:string);
procedure SetActive(Value:Boolean);
procedure SetPrinting(Value:Boolean);
procedure SetDataSet(Value:TADODataSet);
//打印
Function GetExcelCoulmnCaption(num:Cardinal):string;
protected
{ Protected declarations }
public
{ Public declarations }
Constructor Create(AOwner:TComponent); Override;
Destructor Destroy; override;
procedure PrintSqlDataToExcel; overload;
procedure PrintSqlDataToExcel(PB:TRzProgressBar); overload;
published
{ Published declarations }
property SQLString:string
read FSQLString
write SetSQLString;

property DataSet:TADODataSet
read FDataSet
write SetDataSet;

property ExcelTitle:TCaption
read FExcelTitle
write SetExcelTitle;
property ExcelFileName:String
read FExcelFileName
write SetExcelFileName;

property Active:boolean
read FActive
write SetActive;
property Printing:boolean
read FPrinting
write SetPrinting;

end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('rocxu', [TPrintSQL_Data]);
end;

{ TPrintSQL_Data }

constructor TPrintSQL_Data.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;

destructor TPrintSQL_Data.Destroy;
begin
inherited;
end;

function TPrintSQL_Data.GetExcelCoulmnCaption(num: Cardinal): string;
var
mod_num,div_num:Cardinal;
begin
if num=0 then exit;
if (num mod 26=0) then mod_num:=26
else mod_num:=num mod 26;
div_num:=num div 26;
if mod_num=26 then DEC(div_num);
if div_num=0 then
Result:=Chr(64+mod_num)
else Result:=Chr(64+div_num)+Chr(64+mod_num);
end;

procedure TPrintSQL_Data.PrintSqlDataToExcel;
var
I:integer;
Range,ExcelApp,V:variant;
begin
Try
ExcelApp:=CreateOleObject('Excel.application');
Except
MessageDlg('没有安装Office 办公软件Excel!',mtinformation,[MBOK],0);
exit;
End;

try
ExcelApp.WorkBooks.add(Null);
V:=ExcelApp.WorkBooks[1].WorkSheets[1];

//*开始设计标题*/
Range:=V.Range['A1',GetExcelCoulmnCaption(DataSet.Fields.Count)+'1'];
Range.MergeCells:=true;
Range.RowHeight:=24;
Range.HoriZontalAlignMent:=xlCenter;
Range.VerticalAlignMent:=xlCenter;
Range.Font.Name:='新宋体';
Range.Font.size:=16;
Range.Font.FontStyle:='加粗';
Range.Value:=FExcelTitle;
Range.Borders.LineStyle:=xlContinuous; //边框
Range.Borders.Weight:=xlThin;
Range.Borders.ColorIndex:=xlAutomatic;

//显示标题
For i:=0 To DataSet.Fields.Count-1 Do
begin
Range:=V.Range[GetExcelCoulmnCaption(I+1)+'2',GetExcelCoulmnCaption(I+1)+'2'];
Range.RowHeight:=24;
Range.HoriZontalAlignMent:=xlCenter;
Range.VerticalAlignMent:=xlCenter;
Range.Font.Name:='新宋体';
Range.Font.size:=9;
Range.Font.FontStyle:='加粗';
Range.Columns.AutoFit;
Range.Value:=DataSet.Fields[I].FieldName;
Range.Borders.LineStyle:=xlContinuous; //边框
Range.Borders.Weight:=xlThin;
Range.Borders.ColorIndex:=xlAutomatic;
end;
//显示内容
//set
Range:=V.Range['A3',GetExcelCoulmnCaption(DataSet.FieldCount)+IntToStr(DataSet.recordcount+2)];
Range.NumberFormatLocal:= '@';
Range.RowHeight:=20;
Range.HoriZontalAlignMent:=xlCenter;
Range.VerticalAlignMent:=xlCenter;
Range.Borders.LineStyle:=xlContinuous; //边框
Range.Borders.Weight:=xlThin;
Range.Borders.ColorIndex:=xlAutomatic;
Range.Font.Name:='新宋体';
Range.Font.size:=9;
Range.Columns.AutoFit;

DataSet.First;
While (Not DataSet.Eof) do
begin
For i:=0 To DataSet.Fields.Count-1 Do
begin
Range:=V.Range[GetExcelCoulmnCaption(I+1)+IntToStr(DataSet.RecNo+2),GetExcelCoulmnCaption(I+1)+IntToStr(DataSet.RecNo+2)];
if DataSet.Fields[I].IsNull then
Range.Value:=' '
else
Range.Value:=DataSet.Fields[I].AsString;
Range.Borders.LineStyle:=xlContinuous; //边框
Range.Borders.Weight:=xlThin;
Range.Borders.ColorIndex:=xlAutomatic;
end;
DataSet.next;
end;

//显示Excel文档界面
ExcelApp.visible:=true;
V.Activate;
finally
//释放接口对象
ExcelApp:=unassigned;
V:= unassigned;
Range:=unassigned;
end;
end;
winxkm 2006-12-21
  • 打赏
  • 举报
回复
我给你一个我自己写的组件 下载地址:http://www.susuo.com/bbs.official/UpFile/UpAttachment/2006-12/20061221155715.rar,
属性:DataSet 是连接数据集来源
属性:Sqlstring 是连接Dataset执行的SQL语句
属性:Active执行查询
属性:pringting 导出打印!
dovelee 2006-12-21
  • 打赏
  • 举报
回复
不会翻译啊,
cangwu_lee 2006-12-20
  • 打赏
  • 举报
回复
如控制单元格的颜色,边框,插入图片之类的 ----- 在Excel里面操作并同时录制宏,就知道怎么写语句了。

--------------------------------------------------------------
程序,犹如人生。
dovelee 2006-12-20
  • 打赏
  • 举报
回复
各位把你们的代码复制粘贴一下吧
dovelee 2006-12-19
  • 打赏
  • 举报
回复
还有没有别的,比如控制单元格的颜色,边框,插入图片之类的
calmhawkaaa 2006-12-18
  • 打赏
  • 举报
回复
ExcelApplication1: TExcelApplication;
Temp_Worksheet: _WorkSheet;

Try
ExcelApplication1.Connect;
Except
End;
ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks.Add(null,0));


Try
Temp_Worksheet:=ExcelWorkbook1.Sheets[1] as _WorkSheet;
ExcelWorkSheet1.ConnectTo(Temp_WorkSheet);
Except
ShowMessage('Failure');
End;

ExcelWorkSheet1.Cells.Item[1,1].Value := '区县编码';
ExcelWorkSheet1.Cells.Item[1,2].Value := '家庭账号';
ExcelWorkSheet1.Cells.Item[1,3].Value :='人员编号';

....

5,386

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧