如何把我下面的导出excel的线程，封装一个涵数或过程。谢谢 ( 积分: 50 )

  • 主题发起人 主题发起人 jiang5460
  • 开始时间 开始时间
J

jiang5460

Unregistered / Unconfirmed
GUEST, unregistred user!
unit Utoexcel;
interface
uses
Classes, Windows, SysUtils, bsSkinCtrls, Comobj, bsSkinGrids, bsDBGrids, DBGrids, DB;
type
ToExcel = class(TThread)
SentMsg: string;
//传递进程信息
I1: integer;
//总数
I2: integer;
//进度数
procedure postMessages;
//传递信息
procedure QueryMessage;
//显示过程
proceduredo
OutData;
//导出数据
// procedure DBGridInFoToExcel(FileName: string;
MakeDataSource: TDataSource;
makeDBGrid: TbsSkinDBGrid);
private
{ Private declarations }
protected
procedure Execute;
override;
public
constructor Create(Runing: Boolean);
destructor Destroy;
override;
end;

implementation
uses UProgress, UDM, Variants, Uygda;
{ OutToExcel }
constructor ToExcel.Create(Runing: Boolean);
begin
SentMsg := '正在准备将数据导出到Excel，请稍候…………';
Synchronize(postMessages);
Frm_Progress.RzProgressBar1.Percent := 0;
inherited Create(not Runing);
end;

destructor ToExcel.Destroy;
begin
inherited;
end;

procedure ToExcel.DoOutData;
var
exls, sheet: variant;
fieldNum, i, j, k: integer;
S, S2: string;
begin
try
exls := createoleobject('Excel.application');
sheet := createoleobject('excel.sheet');
except
MessageBox(Handle,
'未发现系统中安装了Microsoft Excel，在使用该功能前，请先将其安装！',
'错误',
mb_ok + mb_iconwarning);
Exit;
end;
try
sheet := exls.workBooks.Add;
exls.worksheets[1].range['A1:AF1'].Merge(true);
exls.worksheets[1].Cells[1, 1].value := '员工档案报表';
exls.worksheets[1].Cells[1, 1].Font.Size := 30;
exls.worksheets[1].range['a1:AF1'].HorizontalAlignment := $FFFFEFF4;
exls.worksheets[1].range['a1:AF1'].VerticalAlignment := $FFFFEFF4;
exls.worksheets[1].range['A1:AF1'].Font.Name := '楷体_GB2312';
//第一行高39
exls.worksheets[1].Rows[1].RowHeight := 39;
////////
with Frm_ygda.bsSkinDBGrid1do
begin
for k := 1 to Columns.Count - 1do
begin
exls.Cells[2, k].value := Columns[k - 1].Title.Caption;
exls.Cells[2, k].Font.Size := 9;
end;
end;
with DM.Qryygdado
begin
try
DisableControls;
I1 := RecordCount;
fieldNum := FieldCount;
exls.Cells[2, 8].ColumnWidth := 40;
exls.Cells[2, 31].ColumnWidth := 20;
exls.Cells[2, 32].ColumnWidth := 20;
exls.Cells[2, 33].ColumnWidth := 24;
First;
SentMsg := '正在将数据导出到Excel，请稍候…………';
Synchronize(postMessages);
i := 3;
while not Eofdo
begin
I2 := i - 2;
Synchronize(QueryMessage);
for j := 1 to fieldNum - 2do
begin
exls.Cells[i, j].NUMBERFORMAT := '@';
exls.Cells[i, j] := fields[j - 1].AsString;
exls.Cells[i, j].Font.Size := 9;
//设置字体为小五
end;
Next;
i := i + 1;
EnableControls;
end;

//为表格加入边框
S := 'A2:Af' + IntToStr(RecordCount + 2);
S2 := 'A2:AF' + IntToStr(RecordCount + 2);
exls.worksheets[1].range.Borders.LineStyle := 1;
//设置文字垂直、水平居中
exls.worksheets[1].range[S2].HorizontalAlignment := $FFFFEFF4;
exls.worksheets[1].range[S2].VerticalAlignment := $FFFFEFF4;
//加粗第1、2行文字
exls.Cells[1, 1].Font.Bold := true;
exls.worksheets[1].Rows[2].Font.Bold := true;
//加入一行作者信息]
S := 'A' + IntToStr(RecordCount + 4) + ':AF' + IntToStr(RecordCount +
4);
// exls.worksheets[1].range.Merge(True);
//Exls.Cells[(RecordCount+4),1].value:='“世豪科技OA平台”，程序设计；江智勇　E-Mail：jiangzhiyong8866@163.com';
// exls.Cells[(RecordCount + 4), 1].Font.Size := 9;
// exls.Cells[RecordCount + 4, 1].Font.Bold := True;
//显示Excel
exls.Visible := true;
except
MessageBox(Handle, '数据导出到Excel时，发生意外失败。请稍候再试！',
'错误', mb_ok + MB_ICONERROR);
Exit;
end;
end;
except
MessageBox(Handle, '将数据导出到Excel失败！请稍候再试！', '错误', mb_ok +
MB_ICONERROR);
end;
sheet.Close;
exls.Quit;
exls := UnAssigned;
end;

procedure ToExcel.Execute;
begin
{ Place thread code here }
try
do
OutData;
finally
Frm_Progress.Close;
end;
end;

procedure ToExcel.postMessages;
begin
Frm_Progress.bsSkinGroupBox1.Caption := SentMsg;
end;

procedure ToExcel.QueryMessage;
begin
Frm_Progress.RzProgressBar1.Percent := Round(100 * (I2 / I1));
// 调用进度窗体
end;
end.

有没有更好的导出，导入execel的涵数，谢谢！
 
unit Utoexcel;
interface
uses
Classes, Windows, SysUtils, bsSkinCtrls, Comobj, bsSkinGrids, bsDBGrids, DBGrids, DB;
type
ToExcel = class(TThread)
SentMsg: string;
//传递进程信息
I1: integer;
//总数
I2: integer;
//进度数
procedure postMessages;
//传递信息
procedure QueryMessage;
//显示过程
proceduredo
OutData;
//导出数据
// procedure DBGridInFoToExcel(FileName: string;
MakeDataSource: TDataSource;
makeDBGrid: TbsSkinDBGrid);
private
{ Private declarations }
protected
procedure Execute;
override;
public
constructor Create(Runing: Boolean);
destructor Destroy;
override;
end;

implementation
uses UProgress, UDM, Variants, Uygda;
{ OutToExcel }
constructor ToExcel.Create(Runing: Boolean);
begin
SentMsg := '正在准备将数据导出到Excel，请稍候…………';
Synchronize(postMessages);
Frm_Progress.RzProgressBar1.Percent := 0;
inherited Create(not Runing);
end;

destructor ToExcel.Destroy;
begin
inherited;
end;

procedure ToExcel.DoOutData;
var
exls, sheet: variant;
fieldNum, i, j, k: integer;
S, S2: string;
begin
try
exls := createoleobject('Excel.application');
sheet := createoleobject('excel.sheet');
except
MessageBox(Handle,
'未发现系统中安装了Microsoft Excel，在使用该功能前，请先将其安装！',
'错误',
mb_ok + mb_iconwarning);
Exit;
end;
try
sheet := exls.workBooks.Add;
exls.worksheets[1].range['A1:AF1'].Merge(true);
exls.worksheets[1].Cells[1, 1].value := '员工档案报表';
exls.worksheets[1].Cells[1, 1].Font.Size := 30;
exls.worksheets[1].range['a1:AF1'].HorizontalAlignment := $FFFFEFF4;
exls.worksheets[1].range['a1:AF1'].VerticalAlignment := $FFFFEFF4;
exls.worksheets[1].range['A1:AF1'].Font.Name := '楷体_GB2312';
//第一行高39
exls.worksheets[1].Rows[1].RowHeight := 39;
////////
with Frm_ygda.bsSkinDBGrid1do
begin
for k := 1 to Columns.Count - 1do
begin
exls.Cells[2, k].value := Columns[k - 1].Title.Caption;
exls.Cells[2, k].Font.Size := 9;
end;
end;
with DM.Qryygdado
begin
try
DisableControls;
I1 := RecordCount;
fieldNum := FieldCount;
exls.Cells[2, 8].ColumnWidth := 40;
exls.Cells[2, 31].ColumnWidth := 20;
exls.Cells[2, 32].ColumnWidth := 20;
exls.Cells[2, 33].ColumnWidth := 24;
First;
SentMsg := '正在将数据导出到Excel，请稍候…………';
Synchronize(postMessages);
i := 3;
while not Eofdo
begin
I2 := i - 2;
Synchronize(QueryMessage);
for j := 1 to fieldNum - 2do
begin
exls.Cells[i, j].NUMBERFORMAT := '@';
exls.Cells[i, j] := fields[j - 1].AsString;
exls.Cells[i, j].Font.Size := 9;
//设置字体为小五
end;
Next;
i := i + 1;
EnableControls;
end;

//为表格加入边框
S := 'A2:Af' + IntToStr(RecordCount + 2);
S2 := 'A2:AF' + IntToStr(RecordCount + 2);
exls.worksheets[1].range.Borders.LineStyle := 1;
//设置文字垂直、水平居中
exls.worksheets[1].range[S2].HorizontalAlignment := $FFFFEFF4;
exls.worksheets[1].range[S2].VerticalAlignment := $FFFFEFF4;
//加粗第1、2行文字
exls.Cells[1, 1].Font.Bold := true;
exls.worksheets[1].Rows[2].Font.Bold := true;
//加入一行作者信息]
S := 'A' + IntToStr(RecordCount + 4) + ':AF' + IntToStr(RecordCount +
4);
// exls.worksheets[1].range.Merge(True);
//Exls.Cells[(RecordCount+4),1].value:='“世豪科技OA平台”，程序设计；江智勇　E-Mail：jiangzhiyong8866@163.com';
// exls.Cells[(RecordCount + 4), 1].Font.Size := 9;
// exls.Cells[RecordCount + 4, 1].Font.Bold := True;
//显示Excel
exls.Visible := true;
except
MessageBox(Handle, '数据导出到Excel时，发生意外失败。请稍候再试！',
'错误', mb_ok + MB_ICONERROR);
Exit;
end;
end;
except
MessageBox(Handle, '将数据导出到Excel失败！请稍候再试！', '错误', mb_ok +
MB_ICONERROR);
end;
sheet.Close;
exls.Quit;
exls := UnAssigned;
end;

procedure ToExcel.Execute;
begin
{ Place thread code here }
try
do
OutData;
finally
Frm_Progress.Close;
end;
end;

procedure ToExcel.postMessages;
begin
Frm_Progress.bsSkinGroupBox1.Caption := SentMsg;
end;

procedure ToExcel.QueryMessage;
begin
Frm_Progress.RzProgressBar1.Percent := Round(100 * (I2 / I1));
// 调用进度窗体
end;
end.

有没有更好的导出，导入execel的涵数，谢谢！
 
您必须登录或注册才可回复。

Similar threads

章
在用HttpCli进行多线程下载时，遇到我解决了半天也没解决的问题，请大虾指教。(300分)
回复
3
查看
361
章慧
章
B
我将dbgrid中的数据导入excel中后，想对某一字段排序，该怎么写呀？(100分)
回复
6
查看
128
chinausa
C
B
IDFTP的多线程扫描问题？（200分相送）(100分)
回复
4
查看
404
bamfk1023
B
驿
您好，在多线程遇到一个问题，谢谢指导，欢迎给出关于使用多线程的指导(50分)
回复
11
查看
199
驿路的梦
驿
R
这是把数据库导出为EXCEL的语句，帮我看一下最后的那句是什么意思？过不了，还请帮我看看这段语句能不能成功的把PARADOX表导出为EXCEL2000(50分)
回复
6
查看
239
redwood
R
后退
顶部