Delphi 控制Excel(4)

数据导出为Excel格式
首先要创建一个公共单元,名字你们可以随便起。
以下是我创建的公共单元的全部代码:
unit UnitDatatoExcel;
interface
uses
  Windows,Messages, SysUtils, Classes, Graphics,Controls, Forms,Dialogs,
  DB, ComObj;
type
  TKHTMLFormatCellEvent = procedure(Sender:TObject; CellRow,CellColumn: Integer; FieldName: string;
    varCustomAttrs, CellData: string) of object;
  TDataSetToExcel = class(TComponent)
  private
    FDataSet:TDataSet;
   FOnFormatCell: TKHTMLFormatCellEvent;
  public
    constructorCreate(AOwner: TComponent); override;
    destructorDestroy; override;
    procedureTransfer(const FileName: string; Title: string = ');
  published
    propertyDataSet: TDataSet read FDataSet write FDataSet;
  end;
implementation
constructor TDataSetToExcel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataSet := nil;
end;
destructor TDataSetToExcel.Destroy;
begin
  inherited;
end;
procedure TDataSetToExcel.Transfer(constFileName:string;Title:string = ');
var
  ExcelApp, MyWorkBook: Variant;
  i: byte;
  j, a: integer;
  s, k, b, CustomAttrs: string;
begin
  try
    ExcelApp :=CreateOleObject('Excel.Application');
    MyWorkBook:= CreateOleObject('Excel.Sheet');
  except
    on Exceptiondo raise exception.Create('无法打开Excel文件,请确认已经安装Execl')
  end;
  MyWorkBook := ExcelApp.WorkBooks.Add;
 MyWorkBook.WorkSheets[1].Range['A1:D1'].Merge(True);
 MyWorkBook.WorkSheets[1].Range['A1:D2'].HorizontalAlignment :=$FFFFEFF4;
  MyWorkBook.WorkSheets[1].Cells[1, 1].Value :=Title;
  with FDataSet do
  begin
    i :=2;
    for j := 0to FieldCount - 1 do
    begin
     if Fields[j].Visible then
     begin
       b := Fields[j].DisplayLabel;
       CustomAttrs := ';
       if Assigned(FOnFormatCell) then
         FOnFormatCell(Self, 1, i,
           Fields[j].FieldName, CustomAttrs, b);
       MyWorkBook.WorkSheets[1].Cells[i, j + 1].Value := b;
     end;
    end;
    i :=3;
    Close;
    Open;
    First;
    a :=2;
    while notEof do
    begin
     for j := 0 to FieldCount - 1 do
     begin
       if Fields[j].Visible then
       begin
         CustomAttrs := ';
         k := Fields[j].Text;
         if Assigned(FOnFormatCell) then
           FOnFormatCell(Self, i, a,
             Fields[j].FieldName, CustomAttrs, k);
         MyWorkBook.WorkSheets[1].Cells[i, j + 1].Value := k;
         inc(a);
       end;
     end;
     Inc(i);
     Next;
    end;
  end;
  s := 'A3:D' + IntToStr(i - 1);
  s := 'A1:D' + IntToStr(i - 1);
  MyWorkBook.WorkSheets[1].Columns[1].ColumnWidth:= 20;
  MyWorkBook.WorkSheets[1].Columns[4].ColumnWidth:= 25;
  MyWorkBook.WorkSheets[1].Rows[1].RowHeight :=50;
 MyWorkBook.WorkSheets[1].Rows[1].VerticalAlignMent :=$FFFFEFF4;
  MyWorkBook.WorkSheets[1].Range[s].Font.Name :='仿宋';
  s := 'A2:D' + IntToStr(i - 1);
 MyWorkBook.WorkSheets[1].Range[s].Borders.LineStyle := 1;
 MyWorkBook.WorkSheets[1].PageSetup.CenterHorizontally :=True;
 MyWorkBook.WorkSheets[1].PageSetup.PrintTitleRows := 'A1';
  try
   MyWorkBook.Saveas(FileName);
   MyWorkBook.Close;
  except
   MyWorkBook.Close;
  end;
  ExcelApp.Quit;
  ExcelApp := UnAssigned;
end;
end.
然后在调用它的单元里引用它就行了。
下面是调用它的代码:
procedure ToGetherExcel(NewData: TDataSet; NewString:string);
var
  DataExcel: TDataSetToExcel;
  saveDlg: TSaveDialog;
begin
  saveDlg :=TSaveDialog.Create(nil);  //创建一个存储对话框
  DataExcel := TDataSetToExcel.Create(nil);
  try
   saveDlg.Filter := 'Execl 文件(*.XLS)|*.XLS';
   saveDlg.DefaultExt := 'XLS';
   saveDlg.FileName := NewString;
    ifsaveDlg.Execute then
    begin
     DataExcel.DataSet := NewData;  //连接的数据集
     DataExcel.DataSet.DisableControls;
     DataExcel.Transfer(saveDlg.FileName, NewString);
     DataExcel.DataSet.EnableControls;
     AlterMesg('导出完毕', '提示信息');
    end;
  finally
   saveDlg.Free;
   DataExcel.Free;
  end;
end;
如果谁还有比着更好的办法,请告诉我,咱们共同进步:)


我给大伙发一个吧,调用过程,很方便,
这里DBGrid可更改为Query等与数据库相关的
procedure DBTOExcel(sDBGrid: DBGrid; Title,Fn: string);
//uses ComObj;
//sDBGrid:数据源
//Title:标题
//Fn:保存文件
var
  ExcelApp: Variant;
  i,j,k: Integer;
  __ColStr,__s:String;
begin
  try
    ExcelApp :=CreateOleObject('Excel.Application');
  except
    //onException do raiseexception.Create('无法创建Xls文件,请确认是否安装EXCEL');
   application.MessageBox('系统中的MS Excel软件没有安装或安装不正确!', '错误',MB_ICONERROR + MB_OK);
    exit;
  end;
  ExcelApp.visible := False;
  ExcelApp.WorkBooks.Add;
  ExcelApp.caption := Title;
  __ColStr:=Chr(65+sDBGrid.FieldCount-1);
 ExcelApp.worksheets[1].range['A1:'+__ColStr+'1'].Merge(True);
  //写入标题行
  ExcelApp.Cells[1, 1].Value := Title;
 ExcelApp.worksheets[1].range['A1:'+__ColStr+'3'].HorizontalAlignment:= $FFFFEFF4;
 ExcelApp.worksheets[1].range['A1:'+__ColStr+'3'].VerticalAlignment:= $FFFFEFF4;
 ExcelApp.worksheets[1].range['A2:B2'].Merge(True);
 ExcelApp.worksheets[1].range['C2:D2'].Merge(True);
  ExcelApp.Cells[2, 1].Value :='制表人:'+Myvalue.FUserName;
  ExcelApp.Cells[2, 3].Value :='制表日期:'+DateToStr(Date());
  for i := 1 to sDBGrid.FieldCount do begin
   //各个字段的宽度
   ExcelApp.worksheets[1].Columns[i].ColumnWidth:=sDBGrid.Fields[i-1].DisplayWidth;
    //字段标题
   ExcelApp.Cells[3, i].Value :=sDBGrid.Columns[i-1].Title.caption;
  end;
 ExcelApp.worksheets[1].Range['A1:'+__ColStr+'1'].Font.Name :='黑体';
 ExcelApp.worksheets[1].Range['A1:'+__ColStr+'1'].Font.Size :=16;
 ExcelApp.worksheets[1].range['A1:'+__ColStr+'3'].font.bold:=true;
 ExcelApp.worksheets[1].Range['A2:'+__ColStr+'3'].Font.Size :=10;
  i := 4;
  k := 0;
  sDBGrid.DataSource.DataSet.First;
  while not sDBGrid.DataSource.DataSet.Eof dobegin
    for j := 0to sDBGrid.FieldCount - 1 do begin
     ExcelApp.Cells[i, j + 1].Value := sDBGrid.Fields[j].AsString;
    end;
   sDBGrid.DataSource.DataSet.Next;
    i := i +1;
   k:=k+1;
    __s:='A3:'+__ColStr+IntToStr(i-1);
  end;
  sDBGrid.DataSource.DataSet.First;
 ExcelApp.worksheets[1].Range[__s].HorizontalAlignment :=$FFFFEFF4;
 ExcelApp.worksheets[1].Range[__s].VerticalAlignment :=$FFFFEFF4;
  ExcelApp.worksheets[1].Range[__s].Font.Name :='宋体';
  ExcelApp.worksheets[1].Range[__s].Font.Size :=10;
 ExcelApp.worksheets[1].Range[__s].Borders.LineStyle := 1;
  ExcelApp.ActiveSheet.PageSetup.RightMargin :=0.5/0.035;
  ExcelApp.ActiveSheet.PageSetup.LeftMargin :=2/0.035;
  ExcelApp.ActiveSheet.PageSetup.BottomMargin :=0.5/0.035;
  ExcelApp.visible := True;
  ExcelApp.ActiveCell.Cells.Select;
  ExcelApp.Selection.Columns.AutoFit;
  try
   ExcelApp.ActiveWorkBook.SaveAs(Fn);
  except
  end; 
end;

//导出数据到Excel
procedure ToExcel(DBGrid:TDBGrid);
var
  ExcelApp: Variant;
  i,j,k:integer;
  FileName:string;
  DlgSave:TsaveDialog;
Begin
  DlgSave:=TsaveDialog.Create(nil);
  DlgSave.Filter:='*.xls|*.xls';
  if DlgSave.Execute then
  Begin
   application.ProcessMessages;
   Filename:=DlgSave.FileName;
    ExcelApp :=CreateOleObject( 'Excel.Application' );
   ExcelApp.Caption :='能创监控系统日志数据';//'Microsoft Excel';
   ExcelApp.WorkBooks.Add;
   application.ProcessMessages;
   ExcelApp.WorkSheets[1].Activate;
    K:=1;
    For i:=0 ToDBGrid.Columns.Count-1 Do
    Begin
     if DBGrid.Columns[i].Visible Then
     Begin
       ExcelApp.Cells[1,K]:=DBGrid.Columns[i].Title.Caption;
       k:=k+1;
     End;{if}
   End;{for}
   ExcelApp.rows[1].font.name:='宋体';
   ExcelApp.rows[1].font.size:=10;
   ExcelApp.rows[1].Font.Color:=clBlack;
   ExcelApp.rows[1].Font.Bold:=true;
    j:=1;
    For i:=0 ToDBGrid.Columns.Count-1 Do
    Begin
     If DBGrid.Columns[i].Visible Then
     Begin
       ADOQuery_DB.First;
       for k:=1 To ADOQuery_DB.RecordCount-1 Do
       Begin
         ExcelApp.Cells[K+1,j]:=ADOQuery_DB.FieldByName(DBGrid.Columns[i].FieldName).Asstring;
         ADOQuery_DB.Next;
       End;{for}
     j:=j+1;
   End;{if}
   End;{for}
    For I:=1 ToADOQuery_DB.recordcount Do
   ExcelApp.rows[i].Font.SIZE:=9;
   ExcelApp.Columns.AutoFit;
   ExcelApp.ActiveWorkBook.SaveAs(FileName);
   ExcelApp.WorkBooks.Close;
   Application.MessageBox('数据导出成功....','数据导出',0);
   ExcelApp.Quit;
   ExcelApp:=Unassigned;
   DlgSave.Destroy;
  End;
end;
测试通过!


我可以发一段给你
先在程序上放上三个控件,TExcelApplication,TExcelWorkbook,TExcelWorkSheet,它们都在Server组件板上。
要控制Excel,就是采用自动化编程。以Excel作为自动化服务器。
首先,建立与自动化服务器的连接:
  Excelapplication1.Connect;
  Excelapplication1.Visible[0]:=true;
  Excelapplication1.Caption:='你要的标题';
  ExcelWorkbook1.ConnectTo(Excelapplication1.Workbooks.Add(null,0));
  Excelworksheet1.ConnectTo(Excelworkbook1.Worksheets[0] as_worksheet) ;

然后就可以对Excel进行控件了:
  从数据库导入数据:
 Excel.cells.item[row,col]:=table1.field[i].value;
  ....
最后不要忘了断开连接
  Excelapplication1.disconnect;
  Excelapplication1.quit;
至今是delphi菜鸟

 

 

******************************************************************

如何把在dbgrid的指定几列导到excel表里?
我的做法:用listbox1显示dbgrid的所用供选择列,listbox2用来显示要导出的列:
procedure TForm1.FormCreate(Sender: TObject);
begin
 if kadaoTable1.Active then
 kadaoTable1.GetFieldNames(Listbox1.Items);
end;
procedure TForm1.addbitbtnClick(Sender: TObject);//选择字段
begin
  try
  if listbox1.Items.Count=0 then exit;
  if listbox1.Selected[listbox1.ItemIndex]then
  begin
 Listbox2.Items.Add(Listbox1.Items[Listbox1.ItemIndex]);
  Listbox1.Items.Delete(Listbox1.ItemIndex);
  if Listbox2.Items.Count>=1then
  DeleteBitBtn.Enabled:=True;
  end;
  except
  showmessage('你没有选择相应字段!');
  end;
end;
procedure TForm1.DeleteBitBtnClick(Sender: TObject);//撤消选择
begin
 try
 if Listbox2.Items.Count=0 then exit;
 if listbox2.Selected[Listbox2.ItemIndex]then
   begin
  Listbox1.Items.Add(Listbox2.items[Listbox2.itemindex]);
  Listbox2.Items.Delete(Listbox2.itemindex);
   end;
   if Listbox2.Items.Count=0then
  DeleteBitBtn.Enabled:=False;
 except
 showmessage('你没有选择相应字段!');
 end;
 end;
procedure CopyDbDataToExcel(Args: array of const);
var
  iCount, jCount: Integer;
  XLApp: Variant;
  Sheet: Variant;
  I: Integer;
begin
  Screen.Cursor := crHourGlass;
  if not VarIsEmpty(XLApp) then
  begin
   XLApp.DisplayAlerts := False;
   XLApp.Quit;
   VarClear(XLApp);
  end;
   try
    XLApp :=CreateOleObject('excel.Application');
  except
   Screen.Cursor := crDefault;
  Exit;
  end;

  XLApp.WorkBooks.Add;
  XLApp.SheetsInNewWorkbook := High(Args) +1;
   for I := Low(Args) toHigh(Args) do
  begin
   XLApp.WorkBooks[1].WorkSheets[I+1].Name :=TDBGrid(Args[I].VObject).Name;
    Sheet :=XLApp.Workbooks[1].WorkSheets[TDBGrid(Args[I].VObject).Name];
    if notTDBGrid(Args[I].VObject).DataSource.DataSet.Active then
    begin
     Screen.Cursor := crDefault;
     Exit;
    end;
    TDBGrid(Args[I].VObject).DataSource.DataSet.first;
    for iCount:= 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
     Sheet.Cells[1, iCount + 1] :=TDBGrid(Args[I].VObject).Columns.Items[iCount].Title.Caption;
    jCount := 1;
    while notTDBGrid(Args[I].VObject).DataSource.DataSet.Eof do
    begin
     for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1do
       Sheet.Cells[jCount + 1, iCount + 1] :=TDBGrid(Args[I].VObject).Columns.Items[iCount].Field.AsString;
      Inc(jCount);
     TDBGrid(Args[I].VObject).DataSource.DataSet.Next;
    end;
  end;
   XlApp.Visible := True;
  Screen.Cursor := crDefault;
end;
procedure TForm1.BitBtn3Click(Sender: TObject);//导出操作
begin
CopyDbDataToExcel([DBGrid4]);
end;
我想解决问题有两种办法:一、直接修改CopyDbDataToExcel。二、实现dbgrid4显示的字段列与listbox2中字段同步,dbgrid4中的其余字段要删除掉,不是隐藏。也就是用listbox2中字段来控制哪些字段导入到excel表中呀,如何实现呀? 请高手指点! 

 

*****************************

将dbgrid中数据导出到excel后,如何编写程序使excel的列宽调整为最适合的列宽?
ExcelWorkSheet1.Columns.AutoFit;


************************************

var
  s:string;
  i,j:integer;
begin
  s:='d:\aa\aa.xls'; //文件名
  if fileexists(s) then deletefile(s);
  v:=CreateOLEObject('Excel.Application');//建立OLE对象
  V.WorkBooks.Add;
  if Checkbox1.Checked then
    begin
     V.Visible:=False;
     
     //使Excel可见,并将本程序最小化,以观察Excel的运行情况
    end
  else
    begin
     V.Visible:=True;   //True
    end;
   //使Excel窗口不可见

   //Application.BringToFront; //程序前置
  try
  try
   Cursor:=crSQLWait;
   query1.DisableControls;
    For i:=0 toquery1.FieldCount-1 do //字段数
   //注意:Delphi中的数组的下标是从0开始的,
    //而Excel的表格是从1开始编号
     begin
     V.Goto('R1'+'C'+IntToStr(i+1)); //Excel的表格是从1开始编号
     V.ActiveCell.FormulaR1C1:=query1.Fields[i].FieldName;//传送字段名
     end;
    j:=2;
   query1.First;
    while notquery1.EOF do
     begin
     For i:=0 to query1.FieldCount-1 do //字段数
       begin
         V.Goto('R'+IntToStr(j)+'C'+IntToStr(i+1));
         V.ActiveCell.FormulaR1C1:=query1.Fields[i].AsString;//传送内容
       end;
     query1.Next;
     j:=j+1;
    end;
    //设置保护
   ShowMessage('数据库到Excel的数据传输完毕!');
   
    except//发生错误时
   ShowMessage('没有发现Excel!');
    end;
   finally
   Cursor:=crDefault;
   query1.First;
   query1.EnableControls;
    end;
end;

//和上面的差不多,不过不是从DBGrid中导出的!上面的也不是,只是从Query中
  导出来。我也想知从DBGrid 中怎么样导出来,或直接打印也行!
************************************************

直接使用Excel对象,它是标准的COM对象,可以在Delphi中引用的。
我给你一个函数:
function ExportDataToExcel(cds: TClientDataSet; dbGrid: TDBGrid;ExcelAppData: TExcelApplication;
  Title, strWhere: String): Boolean;
var
  sheet,Range: Variant;
  i,j: Integer;
  str,fVal: String;
begin
  Result := False;
  if (cds = nil) or (not cds.Active) thenExit;
  try
    ifExcelAppData.Tag = 1 then
    begin
     ExcelAppData.Disconnect;
     ExcelAppData.Tag := 0;
    end;
   ExcelAppData.Connect;
   ExcelAppData.Visible[0] := True;
   ExcelAppData.Tag := 1;
  except
   ShowMessage('启动Excel失败,Excel可能没有安装。');
    Abort;
  end;
  cds.DisableControls;
  try
    ifTrim(Title) = ' then Title := '查询结果';
   ExcelAppData.Caption := Title;
   ExcelAppData.Workbooks.Add(emptyparam,0);
    sheet :=ExcelAppData.Workbooks[ExcelAppData.Workbooks.Count].Worksheets[1];

   sheet.name := Title;
    i :=(dbGrid.Columns.Count div 2) - 1;
    if i< 1 then i:=1;
   Sheet.Cells[1,i] := Title;
   ExcelAppData.StandardFontSize[0] := 9; //设置表格字体
    ifdbGrid.Columns.Count < 24 then
    begin
     str := Char(Ord('A') + dbGrid.Columns.Count -1); // 计算最后一列的列标
     Range := Sheet.Range['A3:' + str + '3']; //取出表头的边界
     Range.Columns.Interior.ColorIndex :=8;   //设置表头的颜色
     //计算表格区域
     str := 'A3:' + str + IntToStr(cds.RecordCount + 3);
     Range := Sheet.Range[str]; //取出表格数据区域边界
     Range.Borders.LineStyle :=xlContinuous;   // 设置表格的线条
    end;
   Sheet.Cells[2,1] := strWhere;//'日期:' + DateToStr(Date);
    //写表头
    for j := 0to dbGrid.Columns.Count -1 do
    begin
     Sheet.Cells[3,j + 1] :=dbGrid.Columns.Items[j].Title.Caption;
     Sheet.Columns.Columns[j+1].ColumnWidth :=dbGrid.Columns.Items[j].Width div 6;
    end;

 

  //写表的内容
   cds.First;
    for i:= 4 tocds.RecordCount + 3 do
    begin
     for j := 0 to dbGrid.Columns.Count - 1 do
     begin
       fVal :=Trim(cds.FieldByName(dbGrid.Columns.Items[j].FieldName).AsString);
       Sheet.Cells[i,j + 1] := fVal;
     end;
     cds.Next;
    end;
   Sleep(1000);  //延时1秒,等待Excel处理完成
    Result :=True;
  except on E: Exception do
   ShowMessage('数据导出时出现异常!' + E.Message);
  end;
  ExcelAppData.Disconnect;
  cds.EnableControls;
end;

  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 1
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值