我写的一个实验用的在DELPHI中操作EXCEL的小程序
代码如下：
procedure TForm1.Button1Click(Sender: TObject);
var
bExcelVisble : boolean;
i,j : integer;
TitleStr,fvalue,dispstr : string;
count : integer;begin
if application.MessageBox('启动excel界面吗？','请回答',mb_yesno+mb_defbutton2)<>
idno then
bExcelVisble := true
else
bExcelVisble := false;
try
excelapplication1.Connect;
except
messagedlg('excel 可能未安装！',mterror,[mbok],0);
abort;
end;
excelapplication1.Caption := '从delphi导出数据';
excelapplication1.Workbooks.Add(null,0);
excelworkbook1.ConnectTo(excelapplication1.Workbooks[1]); try
excelworkbook1.Worksheets.Add(null,excelworkbook1.Worksheets[excelworkbook1
.Worksheets.Count],null,null,0);
except
application.MessageBox('创建excel新页失败','错误警报',mb_ok);
exit;
end;
// excelworksheet1.Range['A1','E1'].Merge(true);
// excelworksheet1.Range['A1','D2'].HorizontalAlignment := $ffffeff4;
//excelworksheet1.Cells.Item[1,1].value := adotable1.TableName;
/******************************************************
就是这句有毛病系统不认识item[1,1].value
请高人赐教！
**************************************************************/ i := 2;
count := adotable1.FieldDefList.Count;
for j := 1 to count do
begin
excelworksheet1.Cells.Item[i,j].value := adotable1.Fields[j-1].DisplayLabel;
end;
adotable1.Open;
adotable1.First;
i := 0;
while not adotable1.Eof do
begin
for j := 0 to adotable1.FieldDefList.Count -1 do
begin
if (adotable1.Fields[j].FieldKind = fkcalculated )then
continue;
dispstr := adotable1.Fields[j].AsString;
excelworksheet1.Cells.Item[i+3,j+1].value := dispstr;
end;
adotable1.Next;
i := i +1;
end;
adotable1.Close;
if bexcelvisble then
excelapplication1.Visible[0]:= true
else
begin
if savedialog1.Execute then
begin
try
excelworksheet1.SaveAs(savedialog1.FileName);
application.MessageBox('保存成功','恭喜',mb_ok);
except
application.MessageBox('保存失败','错误警报',mb_ok);
end;
end;
excelapplication1.Disconnect;
excelapplication1.Quit;
end;
end;
代码如下：
procedure TForm1.Button1Click(Sender: TObject);
var
bExcelVisble : boolean;
i,j : integer;
TitleStr,fvalue,dispstr : string;
count : integer;begin
if application.MessageBox('启动excel界面吗？','请回答',mb_yesno+mb_defbutton2)<>
idno then
bExcelVisble := true
else
bExcelVisble := false;
try
excelapplication1.Connect;
except
messagedlg('excel 可能未安装！',mterror,[mbok],0);
abort;
end;
excelapplication1.Caption := '从delphi导出数据';
excelapplication1.Workbooks.Add(null,0);
excelworkbook1.ConnectTo(excelapplication1.Workbooks[1]); try
excelworkbook1.Worksheets.Add(null,excelworkbook1.Worksheets[excelworkbook1
.Worksheets.Count],null,null,0);
except
application.MessageBox('创建excel新页失败','错误警报',mb_ok);
exit;
end;
// excelworksheet1.Range['A1','E1'].Merge(true);
// excelworksheet1.Range['A1','D2'].HorizontalAlignment := $ffffeff4;
//excelworksheet1.Cells.Item[1,1].value := adotable1.TableName;
/******************************************************
就是这句有毛病系统不认识item[1,1].value
请高人赐教！
**************************************************************/ i := 2;
count := adotable1.FieldDefList.Count;
for j := 1 to count do
begin
excelworksheet1.Cells.Item[i,j].value := adotable1.Fields[j-1].DisplayLabel;
end;
adotable1.Open;
adotable1.First;
i := 0;
while not adotable1.Eof do
begin
for j := 0 to adotable1.FieldDefList.Count -1 do
begin
if (adotable1.Fields[j].FieldKind = fkcalculated )then
continue;
dispstr := adotable1.Fields[j].AsString;
excelworksheet1.Cells.Item[i+3,j+1].value := dispstr;
end;
adotable1.Next;
i := i +1;
end;
adotable1.Close;
if bexcelvisble then
excelapplication1.Visible[0]:= true
else
begin
if savedialog1.Execute then
begin
try
excelworksheet1.SaveAs(savedialog1.FileName);
application.MessageBox('保存成功','恭喜',mb_ok);
except
application.MessageBox('保存失败','错误警报',mb_ok);
end;
end;
excelapplication1.Disconnect;
excelapplication1.Quit;
end;
end;
uses ：comobj，db；
Procedure TForm1.Excel_2_db(str :string);
var eclApp,WorkBook :variant ;
xlsFileName :string;
a_FiledCount:integer; //数据库表中的列数
b_filedCount:integer; //excel 文件中的 列数
b_row :integer; // excel 文件的行熟
i,j :integer;
a_flag :boolean;
begin
Form1.OpenDialog1.Title :='Excel文件 导入到数据库'+str+'表';
Form1.OpenDialog1.InitialDir :=ExtractFilePath(Application.ExeName );
if (Form1.OpenDialog1.Execute )
then xlsFileName :=ExtractFileName(Form1.OpenDialog1.FileName)
else exit; try
eclApp := CreateOleObject('Excel.Application');
WorkBook :=CreateOleObject('Excel.Sheet');
except
showmessage('您系统未安装MS-EXCEL');
exit;
end;
try
workBook :=eclApp.WorkBooks.add ;
eclApp.workBooks.open(Form1.OpenDialog1.FileName );
except
on EOleException do
begin
WorkBook.close;
eclApp.quit;
eclApp:=Unassigned;
exit;
end;
end;
eclApp.visible :=false;
try //try ..finally
try //try ..except
With Data_Mod.DataModule1.kcinfo_Tab do
begin
close ;
TableName :=str;
active :=true;
a_FiledCount :=FieldCount; end; b_filedCount :=eclApp.ActiveSheet.UsedRange.columns.Count;//返回excel 表中的列数
b_row :=eclApp.activesheet.UsedRange.rows.count; //返回excel 表中的行数 if (a_FiledCount <>b_FiledCount) //当数据 表和导入的excel表中的列数不一样，说明导入的excel文件不是正确的
then begin
showmessage('您选择导入的excel文件错误'+#13+#10+'请您重新选择');
WorkBook.close;
eclApp.quit;
eclApp:=Unassigned;
exit;
end
else begin //列数正确，但是还要继续判断每列的字段名是否一致
for i :=1 to b_filedCount do
begin
//showmessage(eclApp.activesheet.cells.item[1,i].value);
//showmessage(DataMod.ADO_basic.Fields.Fields[i-1].FieldName ); if eclApp.activesheet.cells.item[2,i].value<>Data_Mod.DataModule1.kcinfo_Tab.Fields[i-1].FieldName //判断字段名是否相等
//if eclApp.activesheet.cells.item[1,i].value<>DataMod.ADO_basic.Fields.Fields[i-1].FieldName //判断中文title.caption 是否相等
then begin
showmessage('您选择导入的excel文件错误'+#13+#10+'请您重新选择');
WorkBook.close;
eclApp.quit;
eclApp:=Unassigned;
Data_Mod.DataModule1.kcinfo_Tab.Close ;
exit;
end;
end; //for i:=.....
end; //end with else for i :=3 to b_row do //行
begin
a_flag :=Data_Mod.DataModule1.kcinfo_Tab.Locate(eclApp.activesheet.cells.item[2,1],eclApp.activesheet.cells.item[i,1],[loCaseInsensitive]);
if (a_flag =true)
then begin
showmessage('该记录已经存在');
Data_Mod.DataModule1.kcinfo_Tab.Next ;
continue;
end; With Data_Mod.DataModule1.kcinfo_Tab do
begin
close ;
TableName :=str;
active :=true;
Append;
end;
For j :=1 to b_filedCount do //列
begin //开始导入数据库
//showmessage(eclApp.activesheet.cells.item[1,j]);//.Value);
////showmessage(eclApp.activesheet.cells.item[i,j].value);
//showmessage(eclApp.activesheet.cells[i,j].value); Data_Mod.DataModule1.kcinfo_Tab.FieldByName(eclApp.activesheet.cells.item[2,j]).Value :=eclApp.activesheet.cells[i,j].value; end ; //end with For j :=1 to b_filedCount do
Data_Mod.DataModule1.kcinfo_Tab.Post ;
Data_Mod.DataModule1.kcinfo_Tab.Refresh ;
end;
showmessage('导入数据成功');
except
WorkBook.close;
eclApp.quit;
eclApp:=Unassigned;
Data_Mod.DataModule1.kcinfo_Tab.Close ;
end; //end try except
finally //操作错误，退出
WorkBook.close;
eclApp.quit;
eclApp:=Unassigned;
Data_Mod.DataModule1.kcinfo_Tab.Close ;
end;
end;
procedure TForm3.Excel4Click(Sender: TObject); //将联合查询的结构转为excel表
var xlsFilename :string;
eclApp,WorkBook :variant ;
a_filedNo,i,j :integer;
begin
a_filedNo :=Form3.DBGrid4.FieldCount ;
xlsFileName :='关于学生成绩基本信息.xls'; try
eclApp :=CreateOleObject('Excel.Application');
WorkBook :=CreateOleObject('Excel.Sheet');
except
showmessage('您的系统没有安装MS EXCEL');
exit;
end; try
WorkBook :=eclApp.workBooks.add ;
for i :=1 to a_FiledNo do //转化字段名；
begin
//eclApp.cells(1,i) :=Form3.DBGrid4.Columns[i-1].Title.caption ;
eclApp.cells(1,i) :=Form3.DBGrid4.Fields[i-1].FieldName ;
end; Form3.DBGrid4.DataSource.DataSet.First ;
for i :=1 to Form3.a_recno do //Form3.a_recno begin
for j :=1 to a_filedNo do //转化一个记录
begin
eclApp.cells(i+1,j) :=Form3.DbGrid4.Fields[j-1].Value ;
end;
Form3.DBGrid4.DataSource.DataSet.Next ;
end;
try
WorkBook.saveas(ExtractFilePath(Application.ExeName )+xlsFileName);
WorkBook.close;
showmessage('保存EXECL文件成功，路径为：'+ExtractFilePath(Application.ExeName )+xlsFileName);
except
showmessage('保存文件出错');
end;
except
showmessage('不能正确操作EXECL文件，可能该文件已经被其他程序占用或系统错误');
WorkBook.close;
eclApp.quit;
eclApp :=Unassigned;
end;
end;
大哥我把你的代码改了改编译！
但这里过不去啊！
eclApp :=CreateOleObject('Excel.Application')；
说是不认识createoleobject是少了什么？
谢谢！
中加入 ComObj eclApp :=CreateOleObject('Excel.Application')；
就可以通过了
发现
eclApp.cells(i+1,j) := dbgrid1.Fields[j-1].Value ;
没有执行
我把改过后的代码贴上来请大家看看！procedure TForm1.Button1Click(Sender: TObject);
var xlsFilename :string;
eclApp,WorkBook :variant ;
a_filedNo,i,j :integer;
begin
a_filedNo :=dbgrid1.FieldCount ;
xlsFileName :='关于学生成绩基本信息.xls'; try eclApp := CreateOleObject('Excel.Application');
WorkBook := CreateOleObject('Excel.Sheet');
except
showmessage('您的系统没有安装MS EXCEL');
exit;
end; try
dbgrid1.DataSource.DataSet.Open;//打开DATASET原作中没有，自已加上的
WorkBook :=eclApp.workBooks.add ;
for i :=1 to a_FiledNo do //转化字段名；
begin
//eclApp.cells(1,i) :=Form3.DBGrid4.Columns[i-1].Title.caption ;
eclApp.cells(1,i) :=dbgrid1.Fields[i-1].FieldName ;
end; dbgrid1.DataSource.DataSet.First ;
for i :=1 to dbgrid1.DataSource.DataSet.RecordCount do //Form3.a_recno，这里我自已改了一下！因为我没有FORM3所以更没有a_recno
//我估计是recordcount begin
for j := 1 to a_filedNo do //转化一个记录
begin
eclApp.cells(i+1,j) := dbgrid1.Fields[j-1].Value ;
{******************************************
这里没有执行！
******************************************} end;
dbgrid1.DataSource.DataSet.Next ;
end;
try
WorkBook.saveas(ExtractFilePath(Application.ExeName )+xlsFileName);
WorkBook.close;
showmessage('保存EXECL文件成功，路径为：'+ExtractFilePath(Application.ExeName )+xlsFileName);
except
showmessage('保存文件出错');
end;
except
showmessage('不能正确操作EXECL文件，可能该文件已经被其他程序占用或系统错误');
WorkBook.close;
eclApp.quit;
eclApp :=Unassigned;
end;
end;
end.
我全部看完还是不明白！你是否掌握能否就SQL TO EXCEL 的方法在这里讲解一下！
谢了！
excelworksheet1.Cells.Item[1,1].value := adotable1.TableName;
应为
excelworksheet1.Cells[1,1]:= adotable1.TableName;