delphi调用Excel2000(75分)

  • 主题发起人 主题发起人 xiaoxiongliu
  • 开始时间 开始时间
X

xiaoxiongliu

Unregistered / Unconfirmed
GUEST, unregistred user!
在使用delphi7时怎样调用excel2000?希望有具体的程序例子进行参考!
谢谢!!(急!)
 
连接上就可以用了,DELPHI7 100例就有一个简单的例子,,
 
下面是我的一段代码,仅供参考
//转换成Excel文档
//muhx 20040423 night
procedure TMainFrm.ChangeToExcel(TmpCelInfo: TCellInfo;
aFileName: string);
var
strSaveFileName: string;
newExcel: Variant;
i: Integer;
begin
strSaveFileName := aFileName;
try
NewExcel := CreateOleObject('Excel.Application');
newExcel.Visible := False;
except
MessageDlg('启动Excel失败!', mtError, [mbOk], 0);
NewExcel.Quit;
NewExcel := Unassigned;
Exit;
end;

try
try
newExcel.DisplayAlerts := False;
newExcel.Caption := '测试数据';
newExcel.WorkBooks.Add;
newExcel.ActiveSheet.Name := '测试数据';
//设置列宽
newExcel.ActiveSheet.Columns[1].ColumnWidth := 7;
newExcel.ActiveSheet.Columns[2].ColumnWidth := 5;
newExcel.ActiveSheet.Columns[3].ColumnWidth := 5;
newExcel.ActiveSheet.Columns[4].ColumnWidth := 11;
newExcel.ActiveSheet.Columns[5].ColumnWidth := 9;
newExcel.ActiveSheet.Columns[6].ColumnWidth := 9;
newExcel.ActiveSheet.Columns[7].ColumnWidth := 9;
newExcel.ActiveSheet.Columns[8].ColumnWidth := 10;
newExcel.ActiveSheet.Columns[9].ColumnWidth := 10;
newExcel.ActiveSheet.Columns[10].ColumnWidth := 16;
//newExcel.ActiveSheet.PageSetup.CenterVertically := 2/0.035;
//添加表头 20040310 muhx
newExcel.Cells[1,5].Value := '测试数据';
newExcel.ActiveSheet.Range['A1:J1'].Borders[3].Weight := 3;
newExcel.ActiveSheet.Range['A1:J1'].Borders[4].Weight := 3;
newExcel.ActiveSheet.Rows[1].Font.Bold := True;
newExcel.Cells[2,1].Value := '通道号';
newExcel.Cells[2,2].Value := '区号';
newExcel.Cells[2,3].Value := '板号';
newExcel.Cells[2,4].Value := '板上电池号';
newExcel.Cells[2,5].Value := '电池编号';
newExcel.Cells[2,6].Value := '通道选择';
newExcel.Cells[2,7].Value := '分选结果';
newExcel.Cells[2,8].Value := '电压(mV)';
newExcel.Cells[2,9].Value := '内阻(mΩ)';
newExcel.Cells[2,10].Value := '检测时间';
newExcel.ActiveSheet.Range['A2:J2'].Borders[4].Weight := 3;
//向Excel工作表中添加内容
for i := 0 to CellNo - 1do
begin
//我自己写的进度条,对这个程序影响不大,我就不写上来了
//ShowWait(CellNo - 1, 0, i, '当前进度:');
newExcel.Cells[i + 3, 1].Value := IntToStr(TmpCelInfo.iCellID);
newExcel.Cells[i + 3, 2].Value := IntToStr(TmpCelInfo.iZoneID);
newExcel.Cells[i + 3, 3].Value := IntToStr(TmpCelInfo.iBoardID);
newExcel.Cells[i + 3, 4].Value := IntToStr(TmpCelInfo.iCellNoInBoard);
newExcel.Cells[i + 3, 5].Value := TmpCelInfo.sCellName;
newExcel.Cells[i + 3, 6].Value := BoolToStr(TmpCelInfo.bCellSelected,True);
newExcel.Cells[i + 3, 7].Value := TmpCelInfo.sSortResult;
newExcel.Cells[i + 3, 8].Value := FormatFloat('0', TmpCelInfo.rVoltage);
newExcel.Cells[i + 3, 9].Value := FormatFloat('0.0', TmpCelInfo.rResistance);
newExcel.Cells[i + 3, 10].Value := DateTimeToStr(TmpCelInfo.tTestTime);
end;

//保存
if not newExcel.ActiveWorkBook.Saved then
newExcel.ActiveWorkBook.SaveAs(strSaveFileName);
//FreeWait;
//若进度条没有释放则释放进度条
sleep(20);
ShowStatusInfo('转换Excel文档完毕');
Application.MessageBox('转换数据完毕。', '提示',
MB_OK or MB_ICONINFORMATION);
except
Application.MessageBox('转换成Excel格式失败!', '测试仪',
MB_OK or MB_ICONWARNING);
end;
finally
newExcel.WorkBooks.Close;
newExcel.Quit;
newExcel := unassigned;
end;
end;
 
我现在也有很多关于这方面的程序例子,但是我不知道需要那些控件来完成,而有些又调试不成功!非常的感谢你们的帮助,希望你们能更进一步帮我解决这个问题!谢谢!!
 
我需要具体做法的详细步骤,程序我也有好些,但是不知道如何实现的?我希望你能在进一步说说怎么做!需要那些控件来做?非常地感谢你的帮助,谢谢!
 
调用Server栏位上的控件啊。。。。。。。。。
 
其实用这些控件是通过Ole来实现的
速度是非常的慢
给你一个不需要Excel/不需要OLE/不需要ADO的程序,速度很快的
unit XLSFile;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Grids, Forms, Dialogs,db,dbctrls,comctrls;
const
{BOF}
CBOF = $0009;
BIT_BIFF5 = $0800;
BOF_BIFF5 = CBOF or BIT_BIFF5;
{EOF}
BIFF_EOF = $000a;
{Document types}
do
CTYPE_XLS = $0010;
{Dimensions}
DIMENSIONS = $0000;
type
TAtributCell = (acHidden,acLocked,acShaded,acBottomBorder,acTopBorder,
acRightBorder,acLeftBorder,acLeft,acCenter,acRight,acFill);
TSetOfAtribut = set of TatributCell;
TXLSWriter = class(Tobject)
private
FStream:TFileStream;
procedure WriteWord(w:word);
protected
procedure WriteBOF;
procedure WriteEOF;
procedure WriteDimension;
public
MaxCols,MaxRows:Word;
procedure CellWord(vCol,vRow:word;aValue:word;vAtribut:TSetOfAtribut=[]);
procedure CellDouble(vCol,vRow:word;aValue:double;vAtribut:TSetOfAtribut=[]);
procedure CellStr(vCol,vRow:word;aValue:String;vAtribut:TSetOfAtribut=[]);
procedure WriteField(vCol,vRow:word;Field:TField);
constructor Create(vFileName:string);
destructor Destroy;override;
end;

procedure SetCellAtribut(value:TSetOfAtribut;var FAtribut:array of byte);
procedure DataSetToXLS(DS:TDataSet;fname:String;PB1:TProgressBar);
procedure StringGridToXLS(grid:TStringGrid;fname:String);
implementation
procedure DataSetToXLS(DS:TDataSet;fname:String;PB1:TProgressBar);
var
c,r,RCount:Integer;
xls:TXLSWriter;
begin
xls:=TXLSWriter.create(fname);
if DS.FieldCount > xls.MaxCols then
xls.MaxCols:=DS.FieldCount+1;
RCount:=DS.RecordCount;
with PB1do
begin
Min:=0;
Max:=RCount;
Step:=1;
end;
try
xls.writeBOF;
xls.WriteDimension;
for c:=0 to DS.FieldCount-1do
begin

xls.Cellstr(0,c,DS.Fields[c].FieldName);
end;
r:=1;
DS.DisableControls;
DS.first;
while (not DS.eof) and (r <= xls.MaxRows)do
begin
for c:=0 to DS.FieldCount-1do
begin
xls.WriteField(r,c,DS.Fields[c]);
end;

inc(r);
PB1.StepIt;
Application.ProcessMessages;
DS.next;
end;
xls.writeEOF;
finally
DS.EnableControls;
xls.free;
end;
end;

procedure StringGridToXLS(grid:TStringGrid;fname:String);
var
c,r,rMax:Integer;
xls:TXLSWriter;
begin
xls:=TXLSWriter.create(fname);
rMax:=grid.RowCount;
if grid.ColCount > xls.MaxCols then
xls.MaxCols:=grid.ColCount+1;
if rMax > xls.MaxRows then
rMax:=xls.MaxRows;
// ??Α程???? 65535 Rows
try
xls.writeBOF;
xls.WriteDimension;
for c:=0 to grid.ColCount-1do
for r:=0 to rMax-1do
xls.Cellstr(r,c,grid.Cells[c,r]);
xls.writeEOF;
finally
xls.free;
end;
end;

{ TXLSWriter }
constructor TXLSWriter.create(vFileName:string);
begin
inherited create;
if FileExists(vFilename) then
FStream:=TFileStream.Create(vFilename,fmOpenWrite)
else
FStream:=TFileStream.Create(vFilename,fmCreate);
MaxCols:=100;
// Column 莱赣琌ぃ???? 65535, ┮?ぃ?矪瞶
MaxRows:=65535;
// 硂??Α程???硂或??叫猔種??戈?畐?甧?碞??硂??
end;

destructor TXLSWriter.destroy;
begin
if FStream <> nil then
FStream.free;
inherited;
end;

procedure TXLSWriter.WriteBOF;
begin
Writeword(BOF_BIFF5);
Writeword(6);
// count of bytes
Writeword(0);
Writeword(DOCTYPE_XLS);
Writeword(0);
end;

procedure TXLSWriter.WriteDimension;
begin
Writeword(DIMENSIONS);
// dimension OP Code
Writeword(8);
// count of bytes
Writeword(0);
// min cols
Writeword(MaxRows);
// max rows
Writeword(0);
// min rowss
Writeword(MaxCols);
// max cols
end;

procedure TXLSWriter.CellDouble(vCol, vRow: word;
aValue:do
uble;vAtribut: TSetOfAtribut);
var
FAtribut:array [0..2] of byte;
begin
Writeword(3);
// opcode fordo
uble
Writeword(15);
// count of byte
Writeword(vCol);
Writeword(vRow);
SetCellAtribut(vAtribut,fAtribut);
FStream.Write(fAtribut,3);
FStream.Write(aValue,8);
end;

procedure TXLSWriter.CellWord(vCol,vRow:word;aValue:word;vAtribut:TSetOfAtribut=[]);
var FAtribut:array [0..2] of byte;
begin
Writeword(2);
// opcode for word
Writeword(9);
// count of byte
Writeword(vCol);
Writeword(vRow);
SetCellAtribut(vAtribut,fAtribut);
FStream.Write(fAtribut,3);
Writeword(aValue);
end;

procedure TXLSWriter.CellStr(vCol, vRow: word;
aValue: String;
vAtribut: TSetOfAtribut);
var
FAtribut:array [0..2] of byte;
slen:byte;
begin
Writeword(4);
// opcode for string
slen:=length(avalue);
Writeword(slen+8);
// count of byte
Writeword(vCol);
Writeword(vRow);
SetCellAtribut(vAtribut,fAtribut);
FStream.Write(fAtribut,3);
FStream.Write(slen,1);
if Trim(aValue)='' then
FStream.Write('',Slen)
else
FStream.Write(aValue[1],Slen);
end;

procedure SetCellAtribut(value:TSetOfAtribut;var FAtribut:array of byte);
var
i:integer;
begin
//reset
for i:=0 to High(FAtribut)do
FAtribut:=0;
// bit sequence 76543210
if acHidden in value then
FAtribut[0] := FAtribut[0] + 128;
//byte 0 bit 7:
if acLocked in value then
FAtribut[0] := FAtribut[0] + 64 ;
//byte 0 bit 6:
if acShaded in value then
FAtribut[2] := FAtribut[2] + 128;
//byte 2 bit 7:
if acBottomBorder in value then
FAtribut[2] := FAtribut[2] + 64 ;//byte 2 bit 6
if acTopBorder in value then
FAtribut[2] := FAtribut[2] + 32;
//byte 2 bit 5
if acRightBorder in value then
FAtribut[2] := FAtribut[2] + 16;
//byte 2 bit 4
if acLeftBorder in value then
FAtribut[2] := FAtribut[2] + 8;
//byte 2 bit 3
// 程? 3 bit 莱?Τ 1 贺匡拒
if acLeft in value then
FAtribut[2] := FAtribut[2] + 1 //byte 2 bit 1
else
if acCenter in value then
FAtribut[2] := FAtribut[2] + 2 //byte 2 bit 1
else
if acRight in value then
FAtribut[2] := FAtribut[2] + 3 //byte 2, bit 0 dan bit 1
else
if acFill in value then
FAtribut[2] := FAtribut[2] + 4;
//byte 2, bit 0
end;

procedure TXLSWriter.WriteWord(w: word);
begin
FStream.Write(w,2);
end;

procedure TXLSWriter.WriteEOF;
begin
Writeword(BIFF_EOF);
Writeword(0);
end;

procedure TXLSWriter.WriteField(vCol, vRow: word;
Field: TField);
begin
case field.DataType of
ftString,ftWideString,ftBoolean,ftDate,ftDateTime,ftTime:
Cellstr(vcol,vrow,field.asstring);
ftAutoInc,ftSmallint,ftInteger,ftWord:
CellWord(vcol,vRow,field.AsInteger);
ftFloat, ftBCD:
CellDouble(vcol,vrow,field.AsFloat);
else
Cellstr(vcol,vrow,EmptyStr);
// ㄤ??篈糶??フ?﹃
end;
end;

end.
 
后退
顶部