非OLE的Excel导出的问题（up有分！）

Question

我参考delphibbs上的一段代码编写了一个unit，内容是关于不使用OLE导出EXCEL，现在可以实现导出功能并且速度挺快的，7000条数据大概2、3，秒。但是目前出现了两个问题：
1。导出数据的表头在非中文的操作系统下显示乱码，例如日文2K。有什么方法可以解决这个问题？
  （我怀疑是没有使用OLE所以Excel不能正确的识别字体）
2。导出的文件较大，但是打开后重新保存就会变小一些，不知什么原因请各位执教。
代码如下：
unit UntObject;interfaceUses
  DB, Classes;var
  CXlsBof: array[0..5] of Word = ($809, 8, 0, $10, 0, 0);
  CXlsEof: array[0..1] of Word = ($0A, 00);
  CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
  CXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);
  CXlsRk: array[0..4] of Word = ($27E, 10, 0, 0, 0);
  CXlsBlank: array[0..4] of Word = ($201, 6, 0, 0, $17);Type
  TDS2Excel = Class(TObject)
  Private
    FCol: word;
    FRow: word;
    FDataSet: TDataSet;
    Stream: TStream;
    FWillWriteHead: boolean;
    FBookMark: TBook;
    procedure IncColRow;
    procedure WriteBlankCell;
    procedure WriteFloatCell(const AValue: Double);
    procedure WriteIntegerCell(const AValue: Integer);
    procedure WriteStringCell(const AValue: string);
    procedure WritePrefix;
    procedure WriteSuffix;
    procedure WriteTitle;
    procedure WriteDataCell;
    procedure Save2Stream(aStream: TStream);
  Public
    procedure Save2File(FileName: string; WillWriteHead: Boolean);
    Constructor Create(aDataSet: TDataSet);
  end;implementationuses SysUtils;Constructor TDS2Excel.Create(aDataSet: TDataSet);
begin
  inherited Create;
  FDataSet := aDataSet;
end;procedure TDS2Excel.IncColRow;
begin
  if FCol = FDataSet.FieldCount - 1 then
  begin
    Inc(FRow);
    FCol :=0;
  end
  else
    Inc(FCol);
end;procedure TDS2Excel.WriteBlankCell;
begin
  CXlsBlank[2] := FRow;
  CXlsBlank[3] := FCol;
  Stream.WriteBuffer(CXlsBlank, SizeOf(CXlsBlank));
  IncColRow;
end;procedure TDS2Excel.WriteFloatCell(const AValue: Double);
begin
  CXlsNumber[2] := FRow;
  CXlsNumber[3] := FCol;
  Stream.WriteBuffer(CXlsNumber, SizeOf(CXlsNumber));
  Stream.WriteBuffer(AValue, 8);
  IncColRow;
end;procedure TDS2Excel.WriteIntegerCell(const AValue: Integer);
var
  V: Integer;
begin
  CXlsRk[2] := FRow;
  CXlsRk[3] := FCol;
  Stream.WriteBuffer(CXlsRk, SizeOf(CXlsRk));
  V := (AValue shl 2) or 2;
  Stream.WriteBuffer(V, 4);
  IncColRow;
end;procedure TDS2Excel.WriteStringCell(const AValue: string);
var
  L: Word;
begin
  L := Length(AValue);
  CXlsLabel[1] := 8 + L;
  CXlsLabel[2] := FRow;
  CXlsLabel[3] := FCol;
  CXlsLabel[5] := L;
  Stream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel));
  Stream.WriteBuffer(Pointer(AValue)^, L);
  IncColRow;
end;procedure TDS2Excel.WritePrefix;
begin
  Stream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
end;procedure TDS2Excel.WriteSuffix;
begin
  Stream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
end;procedure TDS2Excel.WriteTitle;
var
  n: word;
begin
  for n := 0 to FDataSet.FieldCount - 1 do
    WriteStringCell(FDataSet.Fields[n].FieldName);
end;procedure TDS2Excel.WriteDataCell;
var
  n: word;
begin
  WritePrefix;
  if FWillWriteHead then WriteTitle;
  FDataSet.DisableControls;
  FBookMark := FDataSet.GetBook;
  FDataSet.First;
  while not FDataSet.Eof do
  begin
    for n := 0 to FDataSet.FieldCount - 1 do
    begin
      if FDataSet.Fields[n].IsNull then
        WriteBlankCell
      else begin
        case FDataSet.Fields[n].DataType of
          ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
              WriteIntegerCell(FDataSet.Fields[n].AsInteger);
          ftFloat, ftCurrency, ftBCD:
              WriteFloatCell(FDataSet.Fields[n].AsFloat);
        else
          WriteStringCell(FDataSet.Fields[n].AsString);
        end;
      end;
    end;
    FDataSet.Next;
  end;
  WriteSuffix;
  if FDataSet.BookValid(FBookMark) then FDataSet.GotoBook(FBookMark);
  FDataSet.EnableControls;
end;procedure TDS2Excel.Save2Stream(aStream: TStream);
begin
  FCol := 0;
  FRow := 0;
  Stream := aStream;
  WriteDataCell;
end;procedure TDS2Excel.Save2File(FileName: string; WillWriteHead: Boolean);
var
  aFileStream: TFileStream;
begin
  FWillWriteHead := WillWriteHead;
  if FileExists(FileName) then DeleteFile(FileName);
  aFileStream := TFileStream.Create(FileName, fmCreate);
  Try
    Save2Stream(aFileStream);
  Finally
    aFileStream.Free;
  end;
end;end.

Answer 1

http://community.csdn.net/Expert/topic/3402/3402724.xml?temp=.1628534

Answer 2

up, 估计是Excel文件格式还是不很清楚，

Answer 3

為什么寫這么複雜:
我的代碼:
  application.ProcessMessages;
 // try
  excelapplication1:=TExcelapplication.Create(self);
  ExcelWorkbook1:=TExcelWorkbook.Create(self);
  Excelworksheet1:=TExcelWorksheet.Create(self);
  try 
  Excelapplication1.Visible[0]:=true;
  try
  ExcelWorkBook1.ConnectTo(Excelapplication1.Workbooks.Add(EmptyParam,0));
  Except
    raise Exception.Create('鏈接到Excel文件出錯，可能是沒有安裝Excel文件');
  end;
  ExcelWorkSheet1.ConnectTo(ExcelWorkBook1.Worksheets[1] as _WorkSheet);
  ExcelWorksheet1.Cells.Item[1,1]:='領料單號';
  ExcelWorksheet1.Cells.Item[1,2]:='物料編號';
  ExcelWorksheet1.Cells.Item[1,3]:='物料名稱';
  ExcelWorksheet1.Cells.Item[1,4]:='實際領用';
  ExcelWorksheet1.Cells.Item[1,5]:='班組';
  ExcelWorksheet1.Cells.Item[1,6]:='領料日期';
  ExcelWorksheet1.Cells.Item[1,7]:='製單人';
  ExcelWorksheet1.Cells.Item[1,8]:='送料人';
  ExcelWorksheet1.Cells.Item[1,9]:='審核';
  with ExcelWorkSheet1.QueryTables.Add(adoquery1.Recordset,ExcelWorkSheet1.Range['A2', EmptyParam], EmptyParam) do
  begin
    FieldNames:=false;
    refresh(false);
    excelWorksheet1.Range['A1', 'A1'].ColumnWidth:=12.50;
    excelWorksheet1.Range['B1', 'B1'].ColumnWidth:=11.00;
    excelWorksheet1.Range['C1', 'C1'].ColumnWidth:=20;
    excelWorksheet1.Range['D1', 'D1'].ColumnWidth:=8.3;
    Excelworksheet1.range['E1', 'E1'].ColumnWidth:=6;
    Excelworksheet1.range['F1', 'F1'].ColumnWidth:=12.38;
    Excelworksheet1.range['G1', 'G1'].ColumnWidth:=6.75;
    Excelworksheet1.range['H1', 'H1'].ColumnWidth:=6.75;
    Excelworksheet1.range['I1', 'I1'].ColumnWidth:=6.5;
  end;
    ExcelWorksheet1.Range['A1','I1'].Interior.Color:=clskyblue;
    ExcelWorksheet1.Range['A2','A2'].Select;
    Excelapplication1.ActiveWindow.FreezePanes:=true;
    ExcelApplication1.Range['A1', 'I' + inttostr(adoquery1.RecordCount+1)].Borders.LineStyle:= xlContinuous;
  finally
  Excelapplication1.Free;
  ExcelWorkbook1.Free;
  ExcelWorksheet1.Free;
  end;

Answer 4

而非OLE的代碼:
unit EXCEL;interface
uses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, DBGrids, DB, ADODB, Excel2000, OleServer;
 TYPE
   FExcelBook=CLASS(TExcelWorkBook);   //定義基類
   FExcelSheet=CLASS(TExcelWorkSheet); //定義基類
   FExcelApp=CLASS(TExcelApplication); //定義基類
   procedure DataSetToExcel(AFileName: string; STR:VARIANT; ADO_COUNT:VARIANT; ADO:TADOQuery;sheet_name:string); //定義過程
   procedure DataSetToExcel_two(AFileName:string;  STR:VARIANT; ADO_COUNT:VARIANT;  ADO:TADOQuery; Sheet_name:string); //定義過程
   procedure Create_excel(AOwner: TComponent);   //定義過程
   procedure CLOSE_excel (Sender: TObject) ;      //定義過程
implementationuses Unit1;
var app: FExcelApp;
  Sheet: FExcelSheet;
   Book: FExcelBook;
{*調用以下過程的例子: CREATE_EXCEL(SELF) 例2: DATASETTOEXCEL('C:\SN.XLS',FORM1.ADOQuery1.Recordset,FORM1.ADOQuery1.FieldCount,FORM1.ADOQuery1)*}//**********  動態生成 EXCEL 表 **************//
procedure Create_excel (AOwner: TComponent);
begin
app:=FExcelApp.Create(aowner);
Sheet:=FExcelSheet.Create(aowner);
Book:=FExcelBook.Create(aowner);
end;{例子: DATASETTOEXCEL('C:\SN.XLS',FORM1.ADOQuery1.Recordset,FORM1.ADOQuery1.FieldCount,FORM1.ADOQuery1)}//**********  資料寫入 EXCEL 表 **************//
//變量1: EXCEL存盤名稱 ; 變量2: 導入EXCEL數據來源 ; 變量3: 數據的字段個數; 變量4:繼承ADOQUERY類; 變量5:Excel子表名稱
procedure DataSetToExcel(AFileName:string;  STR:VARIANT; ADO_COUNT:VARIANT;  ADO:TADOQuery; Sheet_name:string);
var ado2:integer;S,S1,s2:STRING;
begin
try
App.Visible[0] := TRUE;
try
Book.ConnectTo(App.Workbooks.Add(EmptyParam,0));
except
raise Exception.Create('鏈接到Excel文件出錯，可能是沒有安裝Excel文件');
end;
Sheet.ConnectTo(Book.Worksheets[1] as _WorkSheet);
sheet.Name:=sheet_name; //Excel子表名稱
for ADO2:=1 to ADO_COUNT do //導入字段名稱
      begin  //導入字段名稱到EXCEL
       Sheet.Cells.Item[1,ADO2]:=ADO.Fields[ado2-1].DisplayLabel;//從第一行寫入字段名稱
      end;  //導入字段名稱到EXCEL
with Sheet.QueryTables.Add(STR, Sheet.Range['A2',EmptyParam],EmptyParam) do
begin
//FExcelsheet.Range['a1','Z1'].Borders.ColorIndex:=xlAutomatic;
//FExcelsheet.Range['a1','Z1'].Interior.Color:=clskyblue;
//application.ProcessMessages;
FieldNames := False;
Refresh(False);
end;
ado2:=ADO_COUNT; {* 判定EXCEL字段的位置*}
if ADO_COUNT>25 then
   BEGIN  //大于25
    IF (ADO_COUNT-25)>25 THEN
        BEGIN //二次還大于25
        S:='B'+CHAR(97+(ado2-54));
        END//二次還大于25
    ELSE S:='A'+CHAR(97+(ado2-27)); //一次還大于25
   END //大于25
ELSE // 小于25
S:=CHAR(96+ado2);
s2:=S+INTTOSTR(ADO.RecordCount+1);
S1:=S+'60000';
S:=S+'1';sheet.Range['a1',S1].ColumnWidth:=10; //設定EXCEL字段寬度
sheet.Range['a2','A2'].Select;   //選中EXCEL的A2方塊
sheet.Range['a1',S].Interior.Color:=clskyblue;
sheet.Range['a1',S2].Borders.ColorIndex:=xlAutomatic;
app.ActiveWindow.FreezePanes:=true;//這是凍結動  {* 判定EXCEL字段的位置到此完成*}
{
Book.SaveCopyAs(AFileName);
Book.Close(False);
}
finally
{
App.Quit;
Sheet.Disconnect;
Book.Disconnect;
App.Disconnect;
}
end;
end;//**********  關閉EXCEL並釋放內存  **************//
procedure CLOSE_excel (Sender: TObject);
begin
TRY
Book.Close(False);
App.Quit;
Sheet.Disconnect;
App.Disconnect;
except
raise Exception.Create('關閉Excel文件出錯，可能是Excel沒有打開');
END;
end;//**********  資料寫入 EXCEL 表 **************//
//變量1: EXCEL存盤名稱 ; 變量2: 導入EXCEL數據來源 ; 變量3: 數據的字段個數; 變量4:繼承ADOQUERY類; 變量5:Excel子表名稱
procedure DataSetToExcel_two(AFileName:string;  STR:VARIANT; ADO_COUNT:VARIANT;  ADO:TADOQuery; Sheet_name:string);
var ado2:integer;S,S1,s2:STRING;Temp_Worksheet: _WorkSheet;
begin
// try
//App.Visible[0] := TRUE;
(*try
Book.ConnectTo(App.Workbooks.Add(EmptyParam,0));
except
raise Exception.Create('鏈接到Excel文件出錯，可能是沒有安裝Excel文件');
end;
*)
//Sheet.ConnectTo(Book.Worksheets[1] as _WorkSheet);
//sheet.Name:=sheet_name; //Excel子表名稱
//Temp_Worksheet:=App.Worksheets.Add(EmptyParam,EmptyParam,EmptyParam,EmptyParam,0)as _WorkSheet;
Sheet.ConnectTo(App.Worksheets.Add(EmptyParam,EmptyParam,EmptyParam,EmptyParam,0)as _WorkSheet);
//App.Worksheets.Add(EmptyParam,EmptyParam,EmptyParam,EmptyParam,0)as _WorkSheet;
Sheet.Name:=sheet_name;
for ADO2:=1 to ADO_COUNT do //導入字段名稱
      begin  //導入字段名稱到EXCEL
       Sheet.Cells.Item[1,ADO2]:=ADO.Fields[ado2-1].DisplayLabel;//從第一行寫入字段名稱
      end;  //導入字段名稱到EXCEL
with Sheet.QueryTables.Add(STR, Sheet.Range['A2',EmptyParam],EmptyParam) do
begin
//FExcelsheet.Range['a1','Z1'].Borders.ColorIndex:=xlAutomatic;
//FExcelsheet.Range['a1','Z1'].Interior.Color:=clskyblue;
//application.ProcessMessages;
FieldNames := False;
Refresh(False);
end;
ado2:=ADO_COUNT; {* 判定EXCEL字段的位置*}
if ADO_COUNT>25 then
   BEGIN  //大于25
    IF (ADO_COUNT-25)>25 THEN
        BEGIN //二次還大于25
        S:='B'+CHAR(97+(ado2-54));
        END//二次還大于25
    ELSE S:='A'+CHAR(97+(ado2-27)); //一次還大于25
   END //大于25
ELSE // 小于25
S:=CHAR(96+ado2);
s2:=S+INTTOSTR(ADO.RecordCount+1);
S1:=S+'60000';
S:=S+'1';sheet.Range['a1',S1].ColumnWidth:=10; //設定EXCEL字段寬度
sheet.Range['a2','A2'].Select;   //選中EXCEL的A2方塊
sheet.Range['a1',S].Interior.Color:=clskyblue;
sheet.Range['a1',S2].Borders.ColorIndex:=xlAutomatic;
app.ActiveWindow.FreezePanes:=true;//這是凍結動  {* 判定EXCEL字段的位置到此完成*}
{
Book.SaveCopyAs(AFileName);
Book.Close(False);
}
 //finally
{
App.Quit;
Sheet.Disconnect;
Book.Disconnect;
App.Disconnect;
}
 //end;
end;end.

Answer 5

to  jakefj(夢幻天使) 
非常感谢，研究一下你的代码先^_^

Answer 6

介绍一个笨办法，可以先把数据写入formulaone控件，然后使用formulaone的保存功能，不用去管ole了。

Answer 7

to  jakefj(夢幻天使)
你的这段非OLE的代碼不太正确吧？
app在哪定义的？
而且好像也是使用OLE的方法，至少在interface下就uses了 Excel2000和OleServer