以下是一个数据控件导出为EXCEL表代码,能不能帮我改成LISTVIEW导出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;
    var CustomAttrs, CellData: string) of object;
  TDataSetToExcel = class(TComponent)
  private
    FDataSet: TDataSet;
    FOnFormatCell: TKHTMLFormatCellEvent;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Transfer(const FileName: string; Title: string = '');
  published
    property DataSet: 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(const FileName: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 Exception do 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 := 0 to 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 not Eof 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;
    if saveDlg.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;

解决方案 »

  1.   

    Function ListViewToExcelSheet(ListView:TListView;Sheet:OleVariant): Boolean;
    var
    Row,Col,ItemIndex,SubItemIndex :Integer;
    begin
    Sheet.Activate;tryRow:=1;
    Col:=1;
    for ItemIndex:=0 to ListView.Columns.Count - 1 do
    begin
    Sheet.Cells(Row,Col) := ListView.Columns[ItemIndex].Caption;
    Inc(Col);
    end;
    begin
    for ItemIndex:=0 to ListView.Items.Count - 1 do
    begin
            Row := Row + 1;
            Col := 1;
            Sheet.Cells(Row,Col) := ListView.Items[ItemIndex].Caption;
            Inc(Col);
            for SubItemIndex := 0 to ListView.Items[ItemIndex].SubItems.Count - 1 do
            begin
                    Sheet.Cells(Row,Col):=ListView.Items[ItemIndex].SubItems[SubItemIndex];
                    Inc(Col);
            end;
    end;
    end;Result := True;
    finally
    end;
    end;
    Function ListViewToExcel(ListView:TListView;ExcelFileName:String=''): Boolean; 
    var 
    ExcelObj, Excel, WorkBook, Sheet: OleVariant; 
    OldCursor:TCursor; 
    beginResult := False; OldCursor:=Screen.Cursor; 
    Screen.Cursor:=crHourGlass; try 
    ExcelObj := CreateOleObject('Excel.Sheet');
    Excel := ExcelObj.Application;
    Excel.Visible := False;
    WorkBook := Excel.Workbooks.Add; 
    Sheet:= WorkBook.Sheets[1]; 
    except 
    MessageBox(GetActiveWindow,'无法调用Mircorsoft Excel! '+chr(13)+chr(10)+ '请检查是否安装了Mircorsoft Excel。','提示',MB_OK+MB_ICONINFORMATION);
    Screen.Cursor:=OldCursor; 
    Exit; 
    end; Result:=ListViewToExcelSheet(ListView,Sheet) ; if Result then
    begin 
            WorkBook.SaveAs(FileName:=ExcelFileName);
    end;
    Excel.Quit; 
    Screen.Cursor:=OldCursor; 
    end;
      

  2.   

    调用:ListViewToExcel(listview1,'c:\a.xls');
      

  3.   

    如果文件存在,我点否时,会提示"类 Workbook 的 SaveAs 方法无效"