ListView to Excel / Probl. mit Excel 2003 Zeigt Kästchen an

[Jerry]

Hallo zusammen

Ich habe einen Code geschrieben, der Einträge aus einer ListView in Excel File schreibt.
Vor der Umstellung auf Delphi 2010 hat der Code problemlos funktioniert. Mit Delphi 2010 und Excel 2007 funktioniert es immer noch einwandrei. Wenn ich aber die Excel-Datei mit Excel 2003 öffne, erhalte ich immer zwischen fast jedem Buchstaben ein Kästchen.

Hier mein Code um ein Excel-File zu Erzeugen (Fragt mich aber nicht was die $809 / usw. bedeuten...):

Delphi-Quellcode:

procedure ListViewSaveToXLS(aForm: tForm; Grid: TListViewScroll; OpenYesNo, MailTo: Boolean);
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;
  sFileName: TFileName;
  ExePath: string;
  ProcessID: string;

  // ColOrd: array of Integer;

  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) * SizeOf(Char);
    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
  Application.ProcessMessages;

  // ProzessID ermitteln
  Cache.Value := '';
  Cache.Run('s VALUE=$j');
  ProcessID := Cache.Value;
  if ProcessID = '' then
    Exit;

  // Path und File ermitteln
  ExePath := ExtractFilePath(ParamStr(0));
  sFileName := ExePath + 'Temp\' + ProcessID + '\' + aForm.Caption + '_' + ProcessID + '.xls';
  if not DirectoryExists(ExePath + 'Temp') then
    CreateDir(ExePath + 'Temp');
  if not DirectoryExists(ExePath + 'Temp\' + ProcessID) then
    CreateDir(ExePath + 'Temp\' + ProcessID);
  if FileExists(sFileName) then
    DeleteFile(sFileName);

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

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

      if Items.Count > 0 then
      begin
        // Zuerst den Header
        // Get Column Order (falls durch Benutzer umsortiert)
        { SetLength(ColOrd, Columns.Count);
          ListView_GetColumnOrderArray(Handle, Columns.Count, PInteger(ColOrd)); }

        // for idxItem := 1 to Columns.Count do
        for idxItem := 1 to Columns.Count do
        begin
          with Columns[idxItem - 1] do
          begin
            Val(Columns[idxItem - 1].Caption, i, Code);
            if Code <> 0 then
              XlsWriteCellLabel(FStream, idxItem - 1, 0, Columns[idxItem - 1].Caption)
            else
              XlsWriteCellNumber(FStream, idxItem - 1, 0, i);
          end;
        end;

        // Jetzt die Einträge
        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, Items[idxItem - 1].Caption)
            else
              XlsWriteCellNumber(FStream, 0, idxItem, 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, SubItems[idxSub])
                else
                  XlsWriteCellNumber(FStream, idxSub + 1, idxItem, i);
              end;
            end;
          end;
        end;
      end;
    end;
    FStream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
  finally
    FStream.Free;
  end;

  // File soll gleich geöffnet werden
  if OpenYesNo = True then
  begin
    if not ePowerSuite then
    begin
      ShellExecute(0, 'open', PChar(sFileName), nil, nil, sw_ShowNormal);
    end;
  end;

  // Datei per Mail versenden
  if MailTo then
  begin
    SendFileToMail(Cache.UserMandNr, Cache.UserNr, '', '', sFileName);
  end;
end;

Hat jemand einen Tipp, wenn möglich möchte ich auf eine neue Komponente verzichten.

Vielen Dank für entsprechende Hilfe.

Gruss vom Bodensee

[himitsu]

Stichwort Unicode (2-Byte-Zeichen) ... seit Delphi 2009 wurde Delphi auf Unicode umgestellt.

Und wenn die Schnittstelle ANSI ist, dann wirst du nun auch explizit ANSI (AnsiString, AnsiChar usw.) verwenden müssen.

Delphi-Quellcode:

procedure XlsWriteCellLabel(XlsStream: TStream; const ACol, ARow: Word; const AValue: AnsiString);
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(AValue[1], L);
end;

[Chemiker]

Hallo Jerry,

Zitat von Jerry:

Hier mein Code um ein Excel-File zu Erzeugen (Fragt mich aber nicht was die $809 / usw. bedeuten...):

Du hast doch die Procedure geschrieben, dann solltest Du doch wissen was $809 usw. bedeutet????

Kleine Käschen wo sie nicht hingehören, bedeutet Unicode. Du muss also die Länge der Zeichen anpassen.

Bis bald Chemiker

[Jerry]

Hallo

Die Antwort von Himitsu hat geholfen.

Aber die Antwort von Chemiker: Ich weiss wirklich nicht genau was die $809 etc. bedeuten. Habe auch nichts Schlaues darüber gefunden.

Wie passt man die Länge der Zeichen an?

[Chemiker]

Hallo Jerry,

Biff-Format

Bis bald Chemiker

[shmia]

Warum übergibst du der procedure ListViewSaveToXLS() keinen Dateinamen?
das war eine rethorische Frage; ich will Dich dazu bringen den Code zu verbessern

[Jerry]

Vielen Dank Euch allen für Eure Inputs.
Ich konnte das Problem entsprechend lösen.

Grüsse Jerry