ListView mit Images nach Excel

[Micha]

Ich benutze zwar im Moment die AdvListView, aber ich denke, es müsste ja mit einer normalen ListView das gleiche sein:

Ich habe in der ersten Spalten verschiedene Images, in der 2. und 3. Text. Wenn ich die View jetzt mit Hilfe von nachfolgendem Code nach Excel exportieren will, speichert er leider die Grafiken nicht mit.

Delphi-Quellcode:

Procedure Tfrm_report_std.Button1Click(Sender: TObject);
begin
   if SaveDialog1.Execute then  { <-- ask for a filename first }
    begin
     ListViewSaveToXLS(View, SaveDialog1.FileName);
    end;
end;

procedure Tfrm_report_std.ListViewSaveToXLS(AListView: TListView; const sFileName: TFileName);
const
{$J+}
  CXlsBof: array[0..5] of Word = ($809, 8, 00, $10, 0, 0); 
  CXlsEof: array[0..1] of Word = ($0A, 00); 
  CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0); 
  CXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0); 
{$J-} 
var 
  idxItem, idxSub: Integer; 
  I, Code: Integer;
  ItemCount, SubCount: Word;
  FStream: TFileStream; 

  procedure XlsWriteCellNumber(XlsStream: TStream; const ACol, ARow: Word; 
    const AValue: Double); 
  begin 
    CXlsNumber[2] := ARow; 
    CXlsNumber[3] := ACol; 
    XlsStream.WriteBuffer(CXlsNumber, SizeOf(CXlsNumber)); 
    XlsStream.WriteBuffer(AValue, 8); 
  end; 

  procedure XlsWriteCellLabel(XlsStream: TStream; const ACol, ARow: Word; 
    const AValue: string); 
  var 
    L: Word; 
  begin 
    L := Length(AValue); 
    CXlsLabel[1] := 8 + L; 
    CXlsLabel[2] := ARow; 
    CXlsLabel[3] := ACol; 
    CXlsLabel[5] := L; 
    XlsStream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel)); 
    XlsStream.WriteBuffer(Pointer(AValue)^, L); 
  end; 

begin 
  //Initialization 
  FStream := TFileStream.Create(sFileName, fmCreate); 
  try 
    CXlsBof[4] := 0; 
    FStream.WriteBuffer(CXlsBof, SizeOf(CXlsBof)); 

    with AListView do 
    begin 
      if Items.Count = 0 then 
        ItemCount := 0 
      else 
        ItemCount := Items.Count; 

      if Items.Count > 0 then 
      begin 
        for idxItem := 1 to ItemCount do 
        begin 
          with Items[idxItem - 1] do 
          begin 
          //Save subitems Count 
            if SubItems.Count = 0 then 
              SubCount := 0 
            else 
              SubCount := Subitems.Count; 
            Val(Items[idxItem - 1].Caption, I, Code); 
            if Code <> 0 then 
              XlsWriteCellLabel(FStream, 0, idxItem - 1, Items[idxItem - 1].Caption) 
            else 
              XlsWriteCellNumber(FStream, 0, idxItem - 1, I); 

            if SubCount > 0 then 
            begin 
              for idxSub := 0 to SubItems.Count - 1 do 
              begin 
                //Save Item's Subitems 
                Val(SubItems[idxSub], I, Code); 
                if Code <> 0 then 
                  XlsWriteCellLabel(FStream, idxSub + 1, idxItem - 1, SubItems[idxSub]) 
                else 
                  XlsWriteCellNumber(FStream, idxSub + 1, idxItem - 1, I); 
              end; 
            end; 
          end; 
        end; 
      end; 
    end; 
    FStream.WriteBuffer(CXlsEof, SizeOf(CXlsEof)); 
  finally 
    FStream.Free; 
  end; 
end;

Hat jemand eine Lösung für mich?