关于数据导出的问题！在线等待！！

Question

各位，如何将dbgrid控件中的数据导出到excel中呢？

Answer 1

dataset為dbgrid的數據源。Procedure DataToXLS(DataSet: TDataSet;FileName: String='';InvisibleFieldOut: Boolean=False);
Var MyWorkBook: Variant;
    SaveDialog: TSaveDialog;
    Mark: TBook;
    I,J,K: Integer;
Begin
Screen.Cursor:=crHourGlass;
If Not DataSet.Active Then
 Try
 DataSet.Open;
 Except
 Screen.Cursor:=crDefault;
 Application.MessageBox(PChar('不能啟動資料'+DataSet.Name),'錯誤信息提示',MB_ICONERROR);
 Exit;
 End;
If Trim(FileName)='' Then FileName:=DataSet.Name;
SaveDialog:=TSaveDialog.Create(Application.Owner);
SaveDialog.InitialDir:=GetSystemPath(CSIDL_PERSONAL);
SaveDialog.FileName:=FileName;
SaveDialog.DefaultExt:='XLS';
SaveDialog.Filter:='Excel 活頁簿(*.XLS)|*.XLS|所有檔案(*.*)|*.*';
SaveDialog.Title:='資料匯出保存為';
SaveDialog.Options:=SaveDialog.Options+[ofOverwritePrompt];
If SaveDialog.Execute Then
 FileName:=SaveDialog.FileName
Else
 Begin
 SaveDialog.Free;
 Screen.Cursor:=crDefault;
 Exit;
 End;
SaveDialog.Free;
Try
//ExcelApp:=CreateOleObject('Excel.Application');
MyWorkBook:=CreateOleObject('Excel.Sheet');
Except
Screen.Cursor:=crDefault;
Application.MessageBox(PChar('初始化Excel失敗,請檢查是否已安裝EXCEL!! '),'錯誤信息提示',MB_ICONERROR);
Exit;
End;
Myworkbook.Worksheets[1].Name:=StringReplace(ExtractFileName(FileName),ExtractFileExt(FileName),'',[rfIgnoreCase]);  //設定Excel工作區名字
Myworkbook.Windows[1].WindowState:=2;    //Excel表格最大化
With DataSet Do
 Begin
 Mark:=GetBook;
 DisableControls;
 J:=1;
 For I:=0 To FieldCount-1 Do
  If Fields[I].Visible Or InvisibleFieldOut Then
    Begin
    If Fields[I].DataType In [ftString,ftMemo] Then Myworkbook.Worksheets[1].Columns[J].NumberFormat:='@';  //設定該列為文字類型
    //Myworkbook.Worksheets[1].Columns[J].ShrinkToFit:=True;   //設定該列縮小字型以适合欄寬
    //Myworkbook.Worksheets[1].Columns[J].WrapText:=True;     //設定該列自動換行
    //Myworkbook.Worksheets[1].Columns[J].ColumnWidth:=Fields[I].DisplayWidth;  //設定欄寬
    Myworkbook.Worksheets[1].Cells[1,J].Value:=Fields[I].DisplayLabel;
    Inc(J);
    End;
 //Myworkbook.Worksheets[1].Rows[1].Font.Bold:=True;    //設定該行字体為粗体
 //Myworkbook.Worksheets[1].Rows[1].Font.Color:=clRed;  //設定該行字体的顏色
 First;
 For K:=0 To RecordCount-1 Do
  Begin
  J:=1;
  For I:=0 To FieldCount-1 Do
   If Fields[I].Visible Or InvisibleFieldOut Then
     Begin
     Myworkbook.Worksheets[1].Cells[K+2,J].Value:=Fields[I].AsString;
     Inc(J);
     End;
  //Myworkbook.ActiveSheet.Rows[K+3].Insert;
  Next;
  End;
 GotoBook(Mark);
 FreeBook(Mark);
 EnableControls;
 End;
Screen.Cursor:=crDefault;
Try
 If FileExists(FileName) Then DeleteFile(FileName);
 MyWorkBook.SaveAs(FileName);
Except
 Application.MessageBox(PChar('資料以文件名:'#13#10+FileName+#13#10'保存失敗!! '),'錯誤信息提示',MB_ICONERROR);
 Exit;
End;
If Application.MessageBox('現在要啟動EXCEL對文件進行編輯嗎? ','系統提示',MB_YESNO+MB_ICONQUESTION)=mrYES Then
 Try
 ShellExecute(0,NIL,Pchar(FileName),NIL,NIL,sw_shownormal);
 Except
 Application.MessageBox('啟動EXCEL失敗,請檢查是否已安裝EXCEL!! ','錯誤信息提示',MB_ICONERROR);
 End;
End;

Answer 2

是个函数注意dbgrid是否显示了query（如果数据集是query）中所有的字段，如果不是注意修改。

Answer 3

对不起，我是刚学delphi的，请问如何调用它呢？句首的参数如何赋值呢？

Answer 4

DataToXLS(DataSet: TDataSet;FileName: String='';InvisibleFieldOut: Boolean=False);参数含义
  DataSet: 一个数据集（Table或Query或其他）
  FileName: 要将数据保存为excel文件时使用的文件名（默认''）
  InvisibleFieldOut：是否保存文件（默认不保存）例1: DataToXLS(Table1);
例2: DataToXLS(Table1, '数据文件.XLS', True);