各位大吓:
本人有事相求,如题啊。希望你们能给一个详细实现步骤。。小弟我是刚学DELPHI,许多方面都不懂,不胜感激了!还有,我还在网上找过类似的例程,但不会用,也报错,
// XLApp := CreateOleObject('Excel.Application');
就是上一句,说CreateOleObject没有定义,我机器已安装过OFFICEXP。。还有这个例题,是否与OFFICE版本有关。
//希望前辈告诉我,如何正确使用这个例程,这个例程有无错误,能用吗?如何用(越详细越好),在线等,望告知!谢谢!
procedure CopyDbDataToExcel(Args: array of const);
var
iCount, jCount: Integer;
XLApp: Variant;
Sheet: Variant;
I: Integer;
begin
Screen.Cursor := crHourGlass;
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
VarClear(XLApp);
end; try
XLApp := CreateOleObject('Excel.Application');
except
Screen.Cursor := crDefault;
Exit;
end; XLApp.WorkBooks.Add;
XLApp.SheetsInNewWorkbook := High(Args) + 1; for I := Low(Args) to High(Args) do
begin
XLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGrid(Args[I].VObject).Name;
Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args[I].VObject).Name];
if not TDBGrid(Args[I].VObject).DataSource.DataSet.Active then
begin
Screen.Cursor := crDefault;
Exit;
end; TDBGrid(Args[I].VObject).DataSource.DataSet.first;
for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
Sheet.Cells[1, iCount + 1] :=
TDBGrid(Args[I].VObject).Columns.Items[iCount].Title.Caption;
jCount := 1;
while not TDBGrid(Args[I].VObject).DataSource.DataSet.Eof do
begin
for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
Sheet.Cells[jCount + 1, iCount + 1] :=
TDBGrid(Args[I].VObject).Columns.Items[iCount].Field.AsString;
Inc(jCount);
TDBGrid(Args[I].VObject).DataSource.DataSet.Next;
end;
end;
XlApp.Visible := True;
Screen.Cursor := crDefault;
end;
我这样引用,有错么??
procedure TForm4.BitBtn1Click(Sender: TObject);
begin
CopyDbDataToExcel(DBGrid1);
end;
本人有事相求,如题啊。希望你们能给一个详细实现步骤。。小弟我是刚学DELPHI,许多方面都不懂,不胜感激了!还有,我还在网上找过类似的例程,但不会用,也报错,
// XLApp := CreateOleObject('Excel.Application');
就是上一句,说CreateOleObject没有定义,我机器已安装过OFFICEXP。。还有这个例题,是否与OFFICE版本有关。
//希望前辈告诉我,如何正确使用这个例程,这个例程有无错误,能用吗?如何用(越详细越好),在线等,望告知!谢谢!
procedure CopyDbDataToExcel(Args: array of const);
var
iCount, jCount: Integer;
XLApp: Variant;
Sheet: Variant;
I: Integer;
begin
Screen.Cursor := crHourGlass;
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
VarClear(XLApp);
end; try
XLApp := CreateOleObject('Excel.Application');
except
Screen.Cursor := crDefault;
Exit;
end; XLApp.WorkBooks.Add;
XLApp.SheetsInNewWorkbook := High(Args) + 1; for I := Low(Args) to High(Args) do
begin
XLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGrid(Args[I].VObject).Name;
Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args[I].VObject).Name];
if not TDBGrid(Args[I].VObject).DataSource.DataSet.Active then
begin
Screen.Cursor := crDefault;
Exit;
end; TDBGrid(Args[I].VObject).DataSource.DataSet.first;
for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
Sheet.Cells[1, iCount + 1] :=
TDBGrid(Args[I].VObject).Columns.Items[iCount].Title.Caption;
jCount := 1;
while not TDBGrid(Args[I].VObject).DataSource.DataSet.Eof do
begin
for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
Sheet.Cells[jCount + 1, iCount + 1] :=
TDBGrid(Args[I].VObject).Columns.Items[iCount].Field.AsString;
Inc(jCount);
TDBGrid(Args[I].VObject).DataSource.DataSet.Next;
end;
end;
XlApp.Visible := True;
Screen.Cursor := crDefault;
end;
我这样引用,有错么??
procedure TForm4.BitBtn1Click(Sender: TObject);
begin
CopyDbDataToExcel(DBGrid1);
end;
解决方案 »
- 关于提取所有文件的图标
- 刚踏入江湖,请高手指点江山。。。。。。
- MDI系统子窗体最大化时充满主窗体的客户区如何实现的
- Delphi VCLSkin v2.4 怎么使用阿?
- 请问在Delphi里怎么捕捉Oracle的异常?在线等待
- delphi能实现电信的通信业务吗?怎么做啊!!
- 公开用mediaplay组件播放mpg时抓图的code
- bitmap图片与StreamString的转换。
- **** 50 分**** 怎么把十六进制的UNICODE转换成STRING
- 遇到sql问题,大家帮忙哦!!
- 奇怪!x:=1000 or 100 or 0 or 0,x的值怎么是1004?
- 用ADOStoredProc和ADOQuery执行存储过程有什么区别吗?请高手指点!!
暫時引用ActiveX控件中的Excel90.tlb試下。
現源代碼不知在哪裡了。
var
iCount, jCount: Integer;
XLApp: Variant;
Sheet: Variant;
begin
Screen.Cursor := crHourGlass;
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
VarClear(XLApp);
end;
//--------------------------选择模板------
// CopyFile(pChar(Trim(ExtractFilePath(Application.ExeName))+mb+'.xls'),pChar(FileName+'1.xls'),false);
//------------------------
//通过ole创建Excel对象
try
XLApp := CreateOleObject('Excel.Application');
except
Screen.Cursor := crDefault;
Exit;
end;
if mb = '统计-项目信息前' then
XLApp.WorkBooks.Add[Trim(ExtractFilePath(Application.ExeName))+mb+'.xls'] //你要把数据放在那里啊,先生成个文件在e:\1.xls
else
XLApp.WorkBooks.Add;
XLApp.WorkBooks[1].WorkSheets[1].Name := 'sheet1';
Sheet := XLApp.Workbooks[1].WorkSheets['sheet1'];
if not Target.DataSource.DataSet.Active then
begin
Screen.Cursor := crDefault;
Exit;
end;
Target.DataSource.DataSet.first;for iCount := 0 to Target.Columns.Count - 1 do
begin
Sheet.cells[1, iCount + 1] := trim(Target.Columns.Items[iCount].Title.Caption);
end;jCount := 1;
while not Target.DataSource.DataSet.Eof do
begin for iCount := 0 to Target.Columns.Count - 1 do //
begin
if iCount = 0 then
Sheet.cells[jCount + 1, iCount + 1] := IntToStr(jCount)
else
Sheet.cells[jCount + 1, iCount + 1] := trim(Target.Columns.Items[iCount].Field.AsString);
end;
Inc(jCount);
Target.DataSource.DataSet.Next;
end;
XLApp.ActiveWorkbook.SaveAs(FileName:=FileName); ;
Screen.Cursor := crDefault;
XLApp.ActiveWorkbook.Close;
var
iCount, jCount: Integer;
XLApp: Variant;
Sheet: Variant;
begin
Screen.Cursor := crHourGlass;
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
VarClear(XLApp);
end;
//通过ole创建Excel对象
try
XLApp := CreateOleObject('Excel.Application');
except
Screen.Cursor := crDefault;
Exit;
end;
XLApp.WorkBooks.Add[XLWBatWorksheet];
XLApp.WorkBooks[1].WorkSheets[1].Name := '成功';
Sheet := XLApp.Workbooks[1].WorkSheets['成功'];
if not Target.DataSource.DataSet.Active then
begin
Screen.Cursor := crDefault;
Exit;
end;
Target.DataSource.DataSet.first; for iCount := 0 to Target.Columns.Count - 1 do
begin
Sheet.cells[1, iCount + 1] := Target.Columns.Items[iCount].Title.Caption;
end;
jCount := 1;
while not Target.DataSource.DataSet.Eof do
begin
for iCount := 0 to Target.Columns.Count - 1 do
begin
Sheet.cells[jCount + 1, iCount + 1] := Target.Columns.Items[iCount].Field.AsString;
end;
Inc(jCount);
Target.DataSource.DataSet.Next;
end;
XlApp.Visible := True;
Screen.Cursor := crDefault;
end; //调用
procedure TForm2.SpeedButton5Click(Sender: TObject);
begin
copyDbDataToExcel(dbgrid1);
end;
就是上一句,说CreateOleObject没有定义,我机器已安装过OFFICEXP。。还有这个例题,是否与OFFICE版本有关。
----------------------------
Uses ExcelXP;
上面的代码是我经常用的,你试试。
procedure TF_SoQuery.BitBtn1Click(Sender: TObject);
var
i,row,col:integer;
begin
try
ExcelApplication1.Connect
except
showmessage('不能導出到Excel,請關掉Excel試試') ;
exit;
end ;
ExcelApplication1.Workbooks.Add(Emptyparam,0) ;
ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1] as _Worksheet);
for i:=0 to dm.ADOQ_Sob.FieldCount-1 do
ExcelWorksheet1.Cells.Item[1,i+1]:=dm.ADOQ_Sob.Fields[i].FieldName ;
row:=2;
dm.ADOQ_Sob.First;
while not dm.ADOQ_Sob.Eof do
begin
col:=1;
for i:=0 to dm.ADOQ_Sob.FieldCount-1 do
begin
ExcelWorkSheet1.Cells.Item[row,col]:=dm.ADOQ_Sob.Fields[i].AsString ;
col:=col+1 ;
end;
row:=row+1 ;
dm.ADOQ_Sob.Next ;
end;
if SaveDialog1.Execute then
ExcelworkSheet1.SaveAs(SaveDialog1.FileName);
Excelapplication1.Quit ;
Excelapplication1.Disconnect ;end;
function TForm1.createExcel(desfilename:string):variant;
var
v:variant;
sheet:variant;
begin
v:=createoleobject('Excel.Application');//创建OLE对象
v.workBooks.Open(desfilename);
v.workbooks[1].sheets[1].name:='测试';
sheet:=v.workbooks[1].sheets['测试文件'];
result:= v;
end;procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
v,sheet:variant;
begin
v:=createExcel('temp.xls');//应用程序下要有此excel文件
sheet:= v.workbooks[1].sheets[1];
for i:=1 to 10 do
begin
v.workbooks[1].sheets[1].cells[i,1]:=IntToStr(i);
v.workbooks[1].sheets[1].cells[i,2]:='temp';
v.workbooks[1].sheets[1].cells[i,3]:='tt';
v.workbooks[1].sheets[1].cells[i,4]:='123';
end;
v.workbooks[1].save;
v.workbooks[1].close; //关闭工作表
v.quit; //关闭Excel
v := unassigned;
end;
var
MySQL,ConnStr: string;
begin
ConnStr := 'Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=' + aPath + ';Persist Security Info=False';
MySQL := 'SELECT * INTO [SHEET1] FROM TBLGZFFQKLS IN [ODBC]' + ' [ODBC;Driver=SQL Server;UID=sa;PWD=;Server='+ frmMain.IpCode +';DataBase=SalaryAuidit;]';
try
ADOConnExcel.Connected := False;
ADOConnExcel.ConnectionString := ConnStr;
ADOConnExcel.Connected := True;
ADOConnExcel.Execute(MySQL);
Application.MessageBox('导出EXCEL成功','信息提示!',mb_ok+mb_iconinformation);
ADOConnExcel.Connected := False;
except
Application.MessageBox('导出EXCEL失败','错误!',mb_ok+mb_iconStop);
ADOConnExcel.Connected := False;
end;
end;procedure TFormGzqkHZ.SpeedBPathClick(Sender: TObject);
begin
if OpenDiaEX.Execute then
begin
EditPath.Text := OpenDiaEX.FileName;
end;
end;procedure TFormGzqkHZ.BitBExcellClick(Sender: TObject);
var
MyPath: string;
begin
if EditPath.Text = '' then
begin
Application.MessageBox('请重新输出并选择导出的文件路径','提示',mb_ok+mb_iconstop);
Abort;
end
else
begin
MyPath := EditPath.Text;
if ExtractFileExt(MyPath) = '' then
begin
MyPath := MyPath + '.xls';
end;
end;
if not DirectoryExists(ExtractFilePath(MyPath)) then
ForceDirectories(ExtractFilePath(MyPath));
if FileExists(MyPath) then
begin
if Application.MessageBox('文件已存在,是否覆盖?','提示!',mb_yesno+mb_iconquestion) = idyes then
begin
DeleteFile(MyPath);
end
else
begin
Exit;
end;
end;
DataToExcel(MyPath);
PanelPath.Visible := False;
end;