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

[RWarnecke]

Das Beispiel kapiere ich nicht. Zumal ich im Beitrag #7 ja geschrieben hatte, dass BottomRightCell einen Fehler in Delphi prodiziert.

[p80286]

Es gäbe eine Möglichkeit sich da heran zu tasten:

Delphi-Quellcode:

  excel.visible:=true;  { visible nur für test-zwecke }
  excel.workbooks.Open(Filename:='c:\TEMP\MAPPE1.xls');
  excel.activeworkbook.sheets[1].activate;  { 1. Worksheet}
  showmessage('Shapes:'+inttostr(Excel.activesheet.Shapes.count));
  Excel.activeSheet.Shapes.selectall;
  for i:=1 to excel.ActiveSheet.Shapes.count do begin
    showmessage('Name ist:'+excel.ActiveSheet.Shapes.Range[i].Name);
    showmessage('Left:'+inttostr(excel.ActiveSheet.Shapes.Range[i].left)+#13#10+
                floattostr(excel.ActiveSheet.Columns[1].Width)+#13#10+
                floattostr(excel.ActiveSheet.Columns[2].Width));
  end;

Ist zwar Umständlich aber mit den werten von Height kann man sich dann heran tasten.

Gruß
K-H

( Mein Beispiel Textfeld befindet sich in C6. [Left=122, width=60])

[RWarnecke]

Das war auch zuerst mein Gedanke. Dabei besteht nur ein Problem, woher weiß ich bei wievielen Pixeln die Spalte C anfängt und aufhört.

[p80286]

indem Du Spalte a+Spalte B....
ja ich weiß Umstand ist mein zweiter Vorname. Aber an die Daten kommt man heran.
ggf. baust Du Dir ein Koordinaten-Array, dann mußt Du nur noch ablesen.

Gruß
K-H

[Elvis]

Das hier liefert dir die untere, rechte Zelle.

Delphi-Quellcode:

function FindBottomRightCellOfShape(shape, workSheet : OleVariant)  : OleVariant;
var
  rightColumn,
  bottomRow,
  currentRange : OleVariant;
  right,
  bottom,
  columnIndex,
  rowIndex : Integer;
begin
   right := Integer(shape.Left + shape.Width);
   bottom := Integer(shape.Top + shape.Height);
   rightColumn := Variants.Null;
   bottomRow := Variants.Null;
   result := Variants.Null;

   for columnIndex := Integer(shape.TopLeftCell.Column) to workSheet.Columns.Count do
   begin
     currentRange := workSheet.Columns[columnIndex];
     if (Integer(currentRange.Left) <= right)
     and (Integer(currentRange.Left + currentRange.Width) >= right) then
     begin
       rightColumn := currentRange;
       break;
     end;
   end;
   if VarIsNull(rightColumn) then
      exit;

   for rowIndex := Integer(shape.TopLeftCell.Row) to workSheet.Rows.Count do
   begin
     currentRange := workSheet.Rows[rowIndex];
     if (Integer(currentRange.Top) <= bottom)
     and (Integer(currentRange.Top + currentRange.Height) >= bottom) then
     begin
       bottomRow := currentRange;
       break;
     end;
   end;
   if VarIsNull(bottomRow) then
      exit;

   result := workSheet.Application.Cells[bottomRow.Row, rightColumn.Column];
end;

Die Zellen in dem Bereich kriegst du so:

Delphi-Quellcode:

procedure UseThatTextShape(shape, bottomRightCell : OleVariant);
var
  allCellsRange,
  currentCell : OleVariant;
  cellIndex : Integer;
begin
  allCellsRange := shape.Application.Range[shape.TopLeftCell, bottomRightCell].Cells;
  Writeln(shape.Name, ':');
  Writeln('  TL: ', string(shape.TopLeftCell.Address));
  Writeln('  BR: ', string(bottomRightCell.Address));

  for cellIndex := 1 to allCellsRange.Count do
  begin
    currentCell := allCellsRange.Cells[cellIndex];
    Writeln(' -> ', currentCell.Address);
  end;
end;

[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". Ich habe Deine erste Funktion so aufgerufen :

Delphi-Quellcode:

ExcelApp := GetActiveOleObject('Excel.Application');
for I := 1 to ExcelApp.ActiveSheet.Shapes.Count do
  LB_1.Items.Add(ExcelApp.ActiveSheet.Shapes.Range[i].Name + '--' + FindBottomRightCellOfShape(ExcelApp.ActiveSheet.Shapes.Range[i], ExcelApp.ActiveSheet));

Ich habe es auch Debugged. Die Funktion FindBottomRightCellOfShape wird aufgerufen und der Fehler tritt dann in der folgenden Zeile Deiner Funktion auf :
for columnIndex := Integer(shape.TopLeftCell.Column) to workSheet.Columns.Count do Ich werde es jetzt mal probieren über die Zellenhöhe und Zellenbreite, den Bereich für eine Position eines Textfeldes zu ermitteln. Ist aus meiner Sicht etwas unsauber.

Bin aber weiterhin für Vorschläge offen, die mir ein bisschen mehr Tipparbeit ersparen.

[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));

[RWarnecke]

Zitat von Elvis:

Wenn deine Excel-Version auch kein TopLeftCell hat (welches nutzt du überhaupt?

Ich nutze nur Excel 2007 und 2010. Wenn ich ein Makro direkt in Excel ausführe, dann funktioniert TopLeftCell und BottomRightCell.