LISTVIEW 导入 EXCEL中的问题?????????????

Question

procedure ListViewTO_Excel(ListView1:TListView);
var ExcelApp: Variant;
    i,k:integer;
    s:String;
begin
  //
  if ListView1.Items.Count=0 then exit;
  if ListView1.Columns.Count=0 then exit;
  //创建应用程序
  if not quizmsg('输出到Excel在数据量大时可能需要较长时间，是否继续？') then exit;
  try
//    caption:='正在导出数据到Excel，请稍候...';//caption+'-'+
//    Screen.Cursor:=crHourGlass;
    try
      ExcelApp := CreateOleObject( 'Excel.Application' );
      ExcelApp.WorkBooks.Add;
    except
      errmsg('启动Excel错误，请确认机器安装了Micorosoft Excel！');
      exit;
    end;
    for i:=0 to ListView1.Columns.Count-1 do
    begin
      ExcelApp.WorkSheets[1].Cells[1,i+1].Value :=listview1.Columns[i].Caption;
    end;
    ExcelApp.WorkSheets[1].rows[1].Font.Bold := True;
    ExcelApp.WorkSheets[1].Cells.NumberFormatLocal := '@' ;    for i:=0 to ListView1.Items.Count-1 do
    begin
      ExcelApp.WorkSheets[1].rows[i+1].font.Size:=9;
      for k:=0 to ListView1.Columns.Count-1 do
      begin
        try
          if listview1.Columns[k].tag=0 then
            ExcelApp.WorkSheets[1].Cells[i+2,k+1].Value :=listview1.Items[i].Caption
          else
            if listview1.Items[i].SubItems.count = 0 then
              ExcelApp.WorkSheets[1].Cells[i+2,k+1].Value := ''
            else
              if not (listview1.Items[i].SubItems.Strings[listview1.Columns[k].tag-1] = null) then //pam
                ExcelApp.WorkSheets[1].Cells[i+2,k+1].Value :=
                   listview1.Items[i].SubItems.Strings[listview1.Columns[k].tag-1];
        except
          ExcelApp:=null;
          exit;
        end;
      end;
    end;
    ExcelApp.WorkSheets[1].rows[i+1].font.Size:=9;
    ExcelApp.Visible := True;
  finally
  end;
end;
怎么老是只能把一条记录的第一个字段导入????

Answer 1

这是我从别处COPY来的.
参考一下吧.
copy from advlistview
procedure TAdvListView.SavetoXLS(filename:string);
var
 fexcel:variant;
 fworkbook:variant;
 fworksheet:variant;
 farray:variant;
 s,z:integer;
 rangestr:string[12];
 lis:tlistitem;begin
 screen.cursor:=crHourGlass; try
  FExcel:=CreateOleObject('excel.application');
 except
  screen.cursor:=crDefault;
  raise EAdvListViewError.Create('Excel OLE server not found');
  exit;
 end; FWorkBook := FExcel.WorkBooks.Add;
 FWorkSheet := FWorkBook.WorkSheets.Add; farray:=vararraycreate([0,self.items.count-1,0,self.columns.count-1],varVariant); for s:=0 to self.items.count-1 do
  begin
   lis:=self.items[s];
   for z:=0 to self.columns.count-1 do
    begin
     if z=0 then farray[s,z]:=lis.caption
     else
       begin
        if z-1>=lis.subitems.Count then
         farray[s,z]:=''
        else
         farray[s,z]:=lis.subitems[z-1];
       end;
    end;
  end; rangestr:='A1:'; if (self.Columns.count>26) then
    begin
     rangestr:=rangestr+chr(ord('A')-1+(self.columns.count div 26));
     rangestr:=rangestr+chr(ord('A')-1+(self.columns.count mod 26));
    end
 else
  rangestr:=rangestr+chr(ord('A')-1+self.columns.count); rangestr:=rangestr+inttostr(self.items.count); FWorkSheet.Range[rangestr].Value:=fArray; FWorkbook.SaveAs(filename); FExcel.Quit;
 FExcel:=unassigned; screen.cursor:=crDefault;
end;