输出到Excel时产生问题(50分)

  • 主题发起人 主题发起人 ZhongDe
  • 开始时间 开始时间
Z

ZhongDe

Unregistered / Unconfirmed
GUEST, unregistred user!
我用一段代码把TADODataSet中的数据写到一个已经存在的Excel文件中,文件中有两个sheet
从DataSet写13行到sheet2中,写完后,如果DataSet中如果还有数据,则插入一个Sheet,把Sheet
的数据拷过来,清除应该写入数据的cell的数据,再写入DataSet中的数据,这样重复下去,思路就是这样。
问题是:老是出现“程序执行非法操作”或无效指针。若单步执行,却又能正常执行。请各位朋友帮忙。
Procedure TfMechanics.ClearMoreDataCopied(CurSheet:Variant;StartRow,EndRow:integer);
Var
CurRow:integer;
Begin
For CurRow:=StartRow to EndRow do
Begin
CurSheet.Cells[CurRow,1]:='';
CurSheet.Cells[CurRow,2]:='';
CurSheet.Cells[CurRow,3]:='';
CurSheet.Cells[CurRow,4]:='';
CurSheet.Cells[CurRow,5]:='';
CurSheet.Cells[CurRow,6]:='';
CurSheet.Cells[CurRow,7]:='';
CurSheet.Cells[CurRow,8]:='';
CurSheet.Cells[CurRow,9]:='';
CurSheet.Cells[CurRow,10]:='';
CurSheet.Cells[CurRow,11]:='';
//CurSheet.Cells[CurRow,12]:='';

CurSheet.Cells[CurRow+17,1]:='';

CurSheet.Cells[CurRow+17,3]:='';
CurSheet.Cells[CurRow+17,4]:='';
CurSheet.Cells[CurRow+17,5]:='';
CurSheet.Cells[CurRow+17,6]:='';
CurSheet.Cells[CurRow+17,7]:='';
CurSheet.Cells[CurRow+17,8]:='';
CurSheet.Cells[CurRow+17,9]:='';
CurSheet.Cells[CurRow+17,10]:='';

end;
end;

Function TfMechanics.WriteALine(CurSheet:Variant;ADataSet:TADODataSet;AtRow:Integer):Integer;
Var
CurRow:integer;
Begin
CurRow:=AtRow+10;
CurSheet.Cells[CurRow,1]:=ADataSet.fieldByname('FurnID').AsString;
CurSheet.Cells[CurRow,2]:='';
CurSheet.Cells[CurRow,3]:=ADataSet.FieldByName('TensileStrn').AsString;
CurSheet.Cells[CurRow,4]:=ADataSet.FieldByName('YieldStrn02').AsString;
CurSheet.Cells[CurRow,5]:=ADataSet.FieldByName('YieldStrn10').AsString;
CurSheet.Cells[CurRow,6]:=ADataSet.FieldByName('Elongation').AsString;
CurSheet.Cells[CurRow,7]:=ADataSet.FieldByName('ReduArea').AsString;
CurSheet.Cells[CurRow,8]:=ADataSet.FieldByName('HardnessHB').AsString;
CurSheet.Cells[CurRow,9]:=ADataSet.FieldByName('ImpactStrnA').AsString;
CurSheet.Cells[CurRow,10]:=ADataSet.FieldByName('ImpactStrnB').AsString;
CurSheet.Cells[CurRow,11]:=ADataSet.FieldByName('ImpactStrnC').AsString;
//CurSheet.Cells[CurRow,12]:=ADataSet.FieldByName('ImpactStrnEx').AsString;

CurSheet.Cells[CurRow+17,1]:=ADataSet.fieldByname('FurnID').AsString;

CurSheet.Cells[CurRow+17,3]:=ADataSet.fieldByname('C').AsString;
CurSheet.Cells[CurRow+17,4]:=ADataSet.fieldByname('Si').AsString;
CurSheet.Cells[CurRow+17,5]:=ADataSet.fieldByname('Mn').AsString;
CurSheet.Cells[CurRow+17,6]:=ADataSet.fieldByname('P').AsString;
CurSheet.Cells[CurRow+17,7]:=ADataSet.fieldByname('S').AsString;
CurSheet.Cells[CurRow+17,8]:=ADataSet.fieldByname('Ni').AsString;
CurSheet.Cells[CurRow+17,9]:=ADataSet.fieldByname('Cr').AsString;
CurSheet.Cells[CurRow+17,10]:=ADataSet.fieldByname('Mo').AsString;

Result:=CurRow+1-10;
end;
Function TfMechanics.NewPage(EclApp:Variant;WorkSheet:Variant;StartRow,Rows:integer):Variant;
Var
Cols:integer;
Widths:Array of Double;
iCol:integer;
t1,t2:integer;
Begin
Cols:=WorkSheet.UsedRange.columns.Count;
SetLength(Widths,Cols);
For iCol:=1 to Cols do
Begin
Widths[iCol]:=WorkSheet.Columns[iCol].ColumnWidth;
end;
WorkSheet.Range[WorkSheet.Cells[1,1],WorkSheet.Cells[48,12]].Copy;
WorkSheet:=EclApp.workbooks.item[1].WorkSheets.add;
WorkSheet.Range['A1'].PasteSpecial;

//WorkSheet.Range[WorkSheet.Cells[12,1],WorkSheet.Cells[20,8]].Clear;
ClearMoreDataCopied(WorkSheet,StartRow,StartRow+Rows-1);
For iCol:=1 to Cols do
Begin
WorkSheet.Columns[iCol].ColumnWidth:=Widths[iCol];
end;

Result:=WorkSheet; //<--在这儿 非法操作
end;
Procedure TfMechanics.DataSetToBForm(ADataSet:TADODataSet;xlsFileName:string);
var
EclApp,WorkBook,WorkSheet : Variant;
I : Integer ;
column : Integer ;
Row : Integer ;
NextRow:integer;
Begin
Try
Begin
EclApp := CreateOleObject('Excel.Application');
WorkSheet:=CreateOleObject('Excel.Sheet');
End
Except
ShowMessage('您的计算机上没有 Microsoft Excel!');
Exit;
end;
try
EclApp.visible:=true;
WorkBook:=EclApp.WorkBooks.Open(ExtractFilePath(Application.ExeName)+'RP31Form.xls' );
EclApp.Workbooks.Item[1].Activate;
WorkSheet:=EclApp.Workbooks.item[1].WorkSheets[2];
ADataSet.First;
NextRow:=1;
While Not ADataSet.Eof do
Begin
if NextRow>13 then
Begin
WorkSheet:=NewPage(EclApp,WorkSheet,11,14);
NextRow:=1;
end;
NextRow:=WriteALine(WorkSheet,ADataSet,NextRow); //<--在这儿 无效指针
ADataSet.Next;
end;

if MessageDlg(xlsFileName+'对该文件是否保存?',
mtConfirmation,[mbYes, mbNo], 0) = mrYes then
Begin
WorkBook.saveas(xlsFileName);
workBook.Saved := True;
end
Else
Begin
workBook.Saved := True;
end;
//WorkBook.Close;
eclApp.Quit;
eclApp:=Unassigned;
ShowMessage('EXCEL 文件保存完毕') ;
except
ShowMessage('Excel 文件保存失败');
WorkBook.close;
eclApp.Quit; {释放VARIANT变量}
eclApp:=Unassigned;
end;
end;

Procedure TfMechanics.WriteDataSetToExcel(ADataSet:TDataSet;xlsFileName:String);
var
EclApp,WorkBook : Variant;
I : Integer ;
column : Integer ;
Row : Integer ;
Begin
Try
Begin
EclApp := CreateOleObject('Excel.Application');
WorkBook:=CreateOleObject('Excel.Sheet');
End
Except
ShowMessage('您的计算机上没有 Microsoft Excel!');
Exit;
end;
try
//EclApp.visible:=true;
workBook:=EclApp.workBooks.Add ;
row:=2;
EclApp.Workbooks.Item[1].Activate;
eclApp.Cells.font.colorindex:=5 ;
EclApp.Activesheet.Cells(1,1):=xlsFileName ;
If Not ADataSet.active Then ADataSet.Active := True ;
For I := 1 To ADataSet.FieldCount Do
EclApp.Activesheet.Cells(2,I):=ADataSet.Fields[I-1].FieldName ;
ADataSet.first;
While Not(ADataSet.Eof) do
begin
column:=1;
for i:=1 to ADataSet.FieldCount do
begin
eclApp.Cells.Item[row+1,column]:=ADataSet.fields[i-1].AsString;
column:=column+1;
end;
ADataSet.Next;
row:=row+1;
End ;
WorkBook.saveas(xlsFileName);
WorkBook.close;
WorkBook:=eclApp.workBooks.Open(xlsFileName);
if MessageDlg(xlsFileName+'对该文件是否保存?',
mtConfirmation,[mbYes, mbNo], 0) = mrYes then
WorkBook.save
Else
workBook.Saved := True;
WorkBook.Close;
eclApp.Quit;
eclApp:=Unassigned;
except
ShowMessage('Excel 文件保存失败');
WorkBook.close;
eclApp.Quit; {释放VARIANT变量}
eclApp:=Unassigned;
end;
ShowMessage('EXCEL 文件保存完毕') ;
end;

procedure TfMechanics.Excel31bFormExecute(Sender: TObject);
begin
if SaveDialog1.Execute then
Begin
DataSetToBForm(dtMechanics,SaveDialog1.FileName); //dtMechanics 是要输出的DataSet
end;
end
 

Similar threads

I
回复
0
查看
618
import
I
I
回复
0
查看
781
import
I
I
回复
0
查看
847
import
I
I
回复
0
查看
687
import
I
后退
顶部