怎样将DBgrid中的内容导到EXCEL中?(100分)

  • 主题发起人 主题发起人 bluedna
  • 开始时间 开始时间
B

bluedna

Unregistered / Unconfirmed
GUEST, unregistred user!
怎样将DBgrid中的内容导到EXCEL中?
给个详细一点的例子吧,我试试,
还有我用Ttable控件怎么实现SQL中的GROUP BY 功能?
 
http://www.delphibbs.com/delphibbs/dispq.asp?lid=630160
 
procedure DataToExcel(Grid:TDbGrid;DataSet:TDataset;Title:String;sExcelFile:String);
var
    i,j,Row:integer;
    WB: _WorkBook;
WBs: Workbooks;
FExcelWasFound:Boolean;
ExcelFile:string;
FileHandle: integer;
irange:range;
iWidth:integer;
//oFont:olevariant;
begin
try
Screen.Cursor :=crHourGlass ;
{for i:=0 to Grid.Columns.Count -1 do
begin
Dataset.Fields.DisplayWidth :=Grid.Columns.Width;
end; }
ExcelFile:=sExcelFile;
if not fileExists(ExcelFile) then
begin
FileHandle:=FileCreate(ExcelFile);
Fileclose(FileHandle);
end;
FExcelWasFound := True;
try
FApp := CreateOleObject('Excel.Application.9') as _Application;  //调用Excel2000
  except
    FExcelWasFound := False;
  end;
  if not FExcelWasFound then                  //如果不存在,则调用Excel97
    try
      FApp := CreateOleObject('Excel.Application.8') as _Application;
      FExcelWasFound := True;
    except
      FExcelWasFound := False;
      ShowMessage('Excel调用失败!');
    end;
  if FExcelWasFound then
  begin
    InitVariables;
    New(FSPms);
    with FApp ,FSPms^ do
    begin
      App_SheetsInNewWorkbook := Get_SheetsInNewWorkbook(0);
      App_DisplayFormulaBar := Get_DisplayFormulaBar(0);
      App_ReferenceStyle := Get_ReferenceStyle(0);
      App_DisplayStatusBar := Get_DisplayStatusBar(0);
      Set_SheetsInNewWorkbook(0, 1);
      WBs := Get_Workbooks;                //打开Excel文件
      WB := WBs.Open(excelFile, 3, false, 1,
        '', '', True, $00000002, 1, False,
          False, Null, False, 0);
      MakeVBScript(WB);              //初始化文件属性
    end;
    with FApp do
    begin
      Set_DisplayFormulaBar(0, False);
      Set_ReferenceStyle(0, Integer(xlR1C1));
      Set_DisplayStatusBar(0, False);
      Set_Caption(Title);
    end;
    try
    Row:=1;
    irange:=Fapp.ActiveCell ;
    irange.Font.Size :=9;
    for j:=0 to Grid.FieldCount -1 do
    begin
    if Grid.Columns[j].Visible =true then
begin
if DataSet.Fields[j].displaywidth>254 then
iRange.ColumnWidth:=100
else
begin
//iWidth:=Grid.Columns[j].Width;
iRange.ColumnWidth :=Grid.Columns[j].Field.DisplayWidth ;
end;
irange.Font.Size :=9; //ljq 2001/03/09
irange.value:=Grid.Columns[j].Title.Caption  ;
        irange:=irange.Next;
      end;
    end;
    except
      ShowMessage('调用Excel出错!');
      fApp._Release;
      Screen.Cursor :=crDefault ;
      exit;
    end;
    Row:=Row+2;
    DataSet.DisableControls;
    DataSet.First;
FApp.Get_ActiveWindow.DisplayZeros := True;
irange.NumberFormat:=10;
for i:=0 to DataSet.RecordCount -1 do
begin
irange:=Fapp.Range['A'+IntToStr(Row),'A'+intToStr(Row)];
for j:=0 to Grid.FieldCount -1 Do
begin
if Grid.Columns[j].Visible =True then
begin
if Grid<>nil then
begin
iRange.Font.Size :=Grid.Font.Size;
iRange.Font.Name :=Grid.Font.Name;
end
else
begin
irange.Font.Size :=FFontSize;
irange.Font.Name :=FFontName;
end; //edit by ljq 2001/03/09
iRange.Value :=Grid.Columns[j].Field.AsString ;
irange:=iRange.Next ;
end;
end;
DataSet.next;
Row:=Row+1;
    end;
    Screen.Cursor :=crDefault ;
    DataSet.EnableControls;
    irange:=FApp.Range['A1','K'+intToStr(Row-1)];
    FApp.Set_Visible(0,True);
    CreateToolBar(False);      //屏蔽Excel的系统菜单,采用自定义菜单实现
  end else
  begin
    ShowMessage('调用Excel2000或Excel97失败,请确认是否安装!'+#13#13+' 如果未安装,请先安装office');
    Screen.Cursor :=crDefault ;
  end;
  except
    ShowMessage('调用Excel出错!');
    fApp._Release;
    Screen.Cursor :=crDefault ;
    exit;
  end;
end;

//转贴的:)
 
多人接受答案了。
 
后退
顶部