Wissen welches Textfeld in welcher Zelle ist ? [VBA 2010]

[Elvis]

Zitat von RWarnecke:

Hallo Elvis,

danke erstmal für Deine beiden Funktionen. Ich habe mal versucht diese nachzuvollziehen. Leider gibt es jedesmal die Fehlermeldung "Die Methode 'TopLeftCell' wird vom Automatisierungsobjekt nicht unterstützt".

Wenn deine Excel-Version auch kein TopLeftCell hat (welches nutzt du überhaupt?), dann kannst du ähnlich wie in der von mir geposteten Funktion vorgehen um die Zelle links oben zu finden.

Delphi-Quellcode:

function FindCellAtPos(workSheet : OleVariant;
                       const x,
                             y : Integer;
                       const startAtColumn : Integer = 1;
                       const startAtRow    : Integer = 1) : OleVariant;
var
  foundColumn,
  foundRow,
  currentRange : OleVariant;

  columnIndex,
  rowIndex : Integer;
begin
   foundColumn := Variants.Null;
   foundRow := Variants.Null;
   result := Variants.Null;

   for columnIndex := startAtColumn to Integer(workSheet.Columns.Count) do
   begin
     currentRange := workSheet.Columns[columnIndex];
     if (Integer(currentRange.Left) <= y)
     and (Integer(currentRange.Left + currentRange.Width) >= y) then
     begin
       foundColumn := currentRange;
       break;
     end;
   end;
   if VarIsNull(foundColumn) then
      exit;

   for rowIndex := startAtRow to workSheet.Rows.Count do
   begin
     currentRange := workSheet.Rows[rowIndex];
     if (Integer(currentRange.Top) <= y)
     and (Integer(currentRange.Top + currentRange.Height) >= y) then
     begin
       foundRow := currentRange;
       break;
     end;
   end;
   if VarIsNull(foundRow) then
      exit;

   result := workSheet.Application.Cells[foundRow.Row, foundColumn.Column];
end;

function FindBottomRightCellOfShape(shape, workSheet : OleVariant)  : OleVariant;
begin
   result := FindCellAtPos(workSheet,
                           shape.Left + shape.Width,
                           shape.Top + shape.Height);
end;

function FindTopLeftCellOfShape(shape, workSheet : OleVariant)  : OleVariant;
begin
   result := FindCellAtPos(workSheet,
                           shape.Left,
                           shape.Top);
end;

Wenn du bei neueren Excel-Version direkt die TopleftCell und bottomRightCell auslsen willst, kannst Delphi anonyme Methoden nutzen (auch wenn deren Syntax absolut grauenvoll hässlich ist...)

Delphi-Quellcode:

// returns a delegate which will try to call getValue for the first call,
// and decide whether to use getValue or failOver for every subsequent call
function InititializeGetCellCall(getValue : TFunc<OleVariant, OleVariant>;
                                 failOver : TFunc<OleVariant, OleVariant, OleVariant>) : TFunc<OleVariant, OleVariant, OleVariant>;
var
  innerCall : TFunc<OleVariant, OleVariant, OleVariant>;
begin
  innerCall := function(outerShape, outerWorkSheet : OleVariant) : OleVariant
  var
    dummy : OleVariant;
  begin
    try
      // the first call to "innerCall" tests whether "getValue" thorws an exception
      dummy := getValue(outerShape);

      // nothing blew up, we can simply return the result of "getValue"
      innerCall := function(shape, workSheet : OleVariant) : OleVariant
      begin
         result := getValue(shape);
      end;
    except
      // it did blew up, so we have to use the provided "failOver" delegate
      innerCall := failOver;
    end;

    // this first call has to use the new value of "innerCall" to deliver an actual result
    // further calls will go to "innerCall" directly
    result := innerCall(outerShape, outerWorkSheet);
  end;

  result := function(shape, workSheet : OleVariant) : OleVariant
  begin
    result := innerCall(shape, workSheet);
  end;
end;

var
  getTopLeftCell,
  getBottomRightCell : TFunc<OleVariant, OleVariant, OleVariant>;
  ...
begin
  getTopLeftCell :=  InititializeGetCellCall(function(shape : OleVariant)  : OleVariant
  begin
    // try getting "TopLeftCell" directly on newer Excel Versions
    result := shape.TopLeftCell;
  end,
  FindTopLeftCellofShape);

  getBottomRightCell :=  InititializeGetCellCall(function(shape : OleVariant)  : OleVariant
  begin
    // try getting "BottomRightCell" directly on newer Excel Versions
    result := shape.BottomRightCell;
  end,
  FindBottomRightCellOfShape);

  ...
  UseThatTextShape(shape,
                   getTopLeftCell(shape, workSheet),
                   getBottomRightCell(shape, workSheet));