Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Sonstige Fragen zu Delphi (https://www.delphipraxis.net/19-sonstige-fragen-zu-delphi/)
-   -   Delphi Excel, OLE, Formatierung beschleunigen (https://www.delphipraxis.net/138882-excel-ole-formatierung-beschleunigen.html)

hoika 19. Aug 2009 10:55


Excel, OLE, Formatierung beschleunigen
 
Hallo,

nachdem ich ein StringGrid nach Excel exportiert habe,
will ich Zahlen auch als Zahl exportieren.

Problem: Das dauert ewig.

Der Code sieht wie folgt aus:

Delphi-Quellcode:
      DoubleColumnList:= TDoubleColumnList.Create;
      try
        Grid_GetDoubleColumns(AGrid, DoubleColumnList);

        sFormat:= 'Standard';

        for iDoubleColumnItem:= 0 to DoubleColumnList.Count-1 do
        begin
          DoubleColumnItem:= DoubleColumnList[iDoubleColumnItem];

          sRef_Start:= RefToCell(DoubleColumnItem.iCol+1, DoubleColumnItem.iRowStart+1);
          sRef_End := RefToCell(DoubleColumnItem.iCol+1, DoubleColumnItem.iRowEnd+1);

          bFormatError:= False;
          if sFormat<>'' then
          begin
            try
              Sheet.Range[sRef_Start,sRef_End].NumberFormat:= sFormat;
            except
              bFormatError:= True;
            end;

            if bFormatError then
            begin
              bFormatError:= False;
              sFormat:= 'General';
              try
                Sheet.Range[sRef_Start,sRef_End].NumberFormat:= sFormat;
              except
                bFormatError:= True;
              end;

              if bFormatError then
              begin
                sFormat:= '';
              end;
            end;
          end;

          if bFormatError=False then
          begin
            for iRow:= DoubleColumnItem.iRowStart to DoubleColumnItem.iRowEnd do
            begin
              if TryStrToFloat(AGrid.Cells[DoubleColumnItem.iCol,iRow], dFloat) then
              begin
                sRef:= RefToCell(DoubleColumnItem.iCol+1, iRow+1);
                Sheet.Range[sRef,sRef].Value:= dFloat;
              end;
            end;
          end;
        end; { for iDoubleColumnItem:= 0 to DoubleColumnList.Count-1 do }
      finally
        DoubleColumnList.Free;
      end;
DoubleColumnList enthält eine Liste zusammenhängender Double-Bereiche
(spaltenbezogen, Spalte,Startzeile,Endzeile).
Das ganze drumrum (sFormat) hat mit den verschiedenen Excel-Versionen zu tun (u.a. 2007),
tut aber nix zur Sache.

Lange dauert es, wenn eine Spalte Lücken (z.B. leere Zellen) hat.
Dann gibt es hlt viele Bereiche, die formtiert werden müssen.
Gibt es keine Möglichkeit, mehrere Bereiche auf einmal zu formatieren ?

Hat jemand eine Idee ?

Danke


Heiko

hoika 19. Aug 2009 11:09

Re: Excel, OLE, Formatierung beschleunigen
 
Hallo,

wenn man drüber schreibt ...
Habe gerade mit Makro geprüft.

Range("A1:A2,A4,A5").Select

Ich muss meine Range also nur zusammenbauen


Heiko

hoika 19. Aug 2009 13:28

Re: Excel, OLE, Formatierung beschleunigen
 
Hallo,

geht doch nicht ;(
Der Makro-recorder sagt folgendes

Range("A1:A2,A4,A5").Select
Selection.DisplayFormat:= 'General'

in Delphi
Delphi-Quellcode:
var
  Sheet: OleVariant;

  sRefStr:= 'A1:A2,A4,A5';
  Sheet.Range[sRefStr].Select; // geht nicht, Ole-Fehler
Hat das schon mal jemand gemacht und kann mir auf die Sprünge helfen ?

Danke


Heiko

hoika 19. Aug 2009 14:05

Re: Excel, OLE, Formatierung beschleunigen
 
Hallo,

und hier die Lösung


Habe ich im Internet Range, Union entdeckt (der Artikel von Dirk Selig).

Und mit variabler Anzahl sieht das etwa so aus.

Delphi-Quellcode:
     
var
  XLApp,
  Sheet,
  Range1,
  Range2: OleVariant;
 

      DoubleColumnList:= TDoubleColumnList.Create;
      try
        Grid_GetDoubleColumns(AGrid, DoubleColumnList);

        sFormat:= 'Standard';

        bFormatError:= False;

        try
          if DoubleColumnList.Count>0 then
          begin
            try
             { first range }
              DoubleColumnItem:= DoubleColumnList[0];
              sRef_Start:= RefToCell(DoubleColumnItem.iCol+1,
                                     DoubleColumnItem.iRowStart+1);
              sRef_End := RefToCell(DoubleColumnItem.iCol+1,
                                     DoubleColumnItem.iRowEnd+1);
              Range1:= Sheet.Range[sRef_Start,sRef_End];

             { all others ranges are added via union }
              for iDoubleColumnItem:= 1 to DoubleColumnList.Count-1 do
              begin
                DoubleColumnItem:= DoubleColumnList[iDoubleColumnItem];
                sRef_Start:= RefToCell(DoubleColumnItem.iCol+1,
                                       DoubleColumnItem.iRowStart+1);
                sRef_End := RefToCell(DoubleColumnItem.iCol+1,
                                       DoubleColumnItem.iRowEnd+1);
                Range2:= Sheet.Range[sRef_Start,sRef_End];
                Range1:= XLApp.Union(Range1,Range2);
              end;
              Range1.NumberFormat:= sFormat;
            except
              bFormatError:= True;
            end;

            if bFormatError then
            begin
              bFormatError:= False;
              sFormat:= 'General';
              try
                Range1.NumberFormat:= sFormat;
              except
                bFormatError:= True;
              end;
            end;

            if bFormatError=False then
            begin
              for iDoubleColumnItem:= 0 to DoubleColumnList.Count-1 do
              begin
                DoubleColumnItem:= DoubleColumnList[iDoubleColumnItem];

                for iRow:= DoubleColumnItem.iRowStart to DoubleColumnItem.iRowEnd do
                begin
                  if TryStrToFloat(AGrid.Cells[DoubleColumnItem.iCol,iRow], dFloat) then
                  begin
                    sRef:= RefToCell(DoubleColumnItem.iCol+1, iRow+1);
                    Sheet.Range[sRef,sRef].Value:= dFloat;
                  end;
                end;
              end;
            end;
          end; { if sRefStr<>'' then }
        except
        end;
      finally
        DoubleColumnList.Free;
      end;
und hier noch die Hilfs-Routine

Delphi-Quellcode:
type
  TBusinessObject = class;
  TBusinessObjectList=class(TList);

type
  TDoubleColumnItem = class(TBusinessObject)
    public
      iCol     : Integer;
      iRowStart : Integer;
      iRowEnd  : Integer;
  end; { TDoubleColumnItem }
type
  TDoubleColumnList = class(TBusinessObjectList)

procedure Grid_GetDoubleColumns(const theGrid: TStringGrid;
  theDoubleColumnList: TDoubleColumnList);

  procedure Add2List(const theCol, theRowStart, theRowEnd: Integer);
  var
    DoubleColumnItem: TDoubleColumnItem;
  begin
    DoubleColumnItem:= TDoubleColumnItem.Create;
    DoubleColumnItem.iCol     := theCol;
    DoubleColumnItem.iRowStart := theRowStart;
    DoubleColumnItem.iRowEnd  := theRowEnd;
    theDoubleColumnList.Add(DoubleColumnItem);
  end;

var
  iRow       : Integer;
  iCurCol    : Integer;
  iCurRow    : Integer;
  bInRange   : Boolean;
  iRangeStart : Integer;
  iRangeEnd  : Integer;
  dDouble    : Double;
begin
  theDoubleColumnList.ClearList;

  iRangeStart := 0;
  iRangeEnd  := 0;

  for iCurCol:= 0 to theGrid.ColCount-1 do
  begin
    bInRange := False;
    iCurRow := -1;
    for iRow:= 0 to theGrid.RowCount-1 do
    begin
      Inc(iCurRow);

      if TryStrToFloat(theGrid.Cells[iCurCol,iCurRow], dDouble) then
      begin
       { cell is a double }
        if not bInRange then
        begin
         { new range begins }
          iRangeStart := iCurRow;
          iRangeEnd  := iCurRow;
          bInRange   := True;
        end
        else
        begin
         { range is updated }
          iRangeEnd:= iCurRow;
        end;
      end
      else
      begin
       { cell is not double
         if we are in a range, we add this range to the list }
        if bInRange then
        begin
          Add2List(iCurCol, iRangeStart, iRangeEnd);
          bInRange:= False;
        end;
      end;
    end;

    if bInRange then
    begin
      Add2List(iCurCol, iRangeStart, iRangeEnd);
    end;
  end; { for iCurCol:= 0 to theGrid.ColCount-1 do }
end; { Grid_GetDoubleColumns }
Jetzt geht der Export ratz fatz *freu


Heiko


Alle Zeitangaben in WEZ +1. Es ist jetzt 11:04 Uhr.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz