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

[RWarnecke]

Hallo zusammen,

ich muss eine Exceldatei 2010 auslesen. In dieser Exceldatei sind Textfelder, keine Textboxen, im Bereich einzelner bestimmten Zellen positioniert. Wie bekomme ich über VBA raus, ob sich ein Textfeld im Bereich dieser Zelle befindet ?

Edit: Crosspost

[p80286]

Hast du es mal mit dem Format versucht?

Gruß
K-H

[RWarnecke]

Mit welchem Format ? Ich habe nicht so viel Erfahrung in VBA.

[RWarnecke]

Über das folgende Makro kann ich ermitteln, welches Textfeld in welcher Zelle ist : (Quelle aus dem Crosspost)

Code:

Sub Makro1()
    Dim shpe As Shape
    For Each shpe In ActiveSheet.Shapes
        Debug.Print shpe.Name
        If shpe.Name Like "Text Box*" Then
            If Not Intersect(Range("F10"), Range(shpe.TopLeftCell, shpe.BottomRightCell)) Is Nothing Then
                'hier der Code, der ausgeführt werden soll,
                'wenn sich eine Textbox
                'im Bereich der Zelle C3 befindet.
                'die Textbox kann über die Variabele "shpe" angesprochen werden
                MsgBox "im Bereich der Zelle F10 liegt das Textfeld " & shpe.Name
            End If
        End If
    Next
End Sub

Jetzt ist nur noch die Frage, wie bringe ich dieses Makro rüber nach Delphi, dass ich die Werte in Delphi ermitteln und anzeigen kann ? Es sollte möglichst ohne Änderungen in den Exceldateien möglich sein.

[Jumpy]

Wenn in dem Dokument, die Textfelder wirklich nur in einer Zelle stehen, also nicht über mehrere Zellen gehen, sind shpe.TopLeftCell und shpe.BottomRightCell dasselbe, nämlich die gesuchte Zelle. Diese kannst du dir afaik auch über shpe.TopLeftCell.Adress anzeigen lassen, oder auswerten.

Dann brauchts du weder Intersect noch Range. Beides sind ja Excel-Funktionen, wo ich auch nicht wüsste, wie die bei OLE rüberkommen...

[p80286]

Mit "Format" meine ich das Zellenformat, habe gerade kein Excel zur Hand um nach zu schauen.
Das Makro hat ja mit "Text Box" zu tun, das hattest Du doch eigentlich ausgeschlossen?

Gruß
K-H

[RWarnecke]

Zitat:

Zitat von p80286 (Beitrag 1176237)

Mit "Format" meine ich das Zellenformat, habe gerade kein Excel zur Hand um nach zu schauen.

Wie soll mir das weiterhelfen, wenn das Textfeld kleiner ist als die Zelle selber ?

Zitat:

Zitat von p80286 (Beitrag 1176237)

Das Makro hat ja mit "Text Box" zu tun, das hattest Du doch eigentlich ausgeschlossen?

Das ist auch richtig so, dass ich Text Box ausgeschlossen habe. Das Textfeld heißt nur so. In meinem VBA Beispiel prüfe ich ja nur auf den Namen ab, der halt "Text Box" heißt.

Zitat:

Zitat von Jumpy (Beitrag 1176229)

Wenn in dem Dokument, die Textfelder wirklich nur in einer Zelle stehen, also nicht über mehrere Zellen gehen, sind shpe.TopLeftCell und shpe.BottomRightCell dasselbe, nämlich die gesuchte Zelle. Diese kannst du dir afaik auch über shpe.TopLeftCell.Adress anzeigen lassen, oder auswerten.

TopLeftCell und BottomRightCell liefern in Delphi den Fehler:

Zitat:

---------------------------
Debugger Exception Notification
---------------------------
Project XLSTestFeld.exe raised exception class EOleError with message 'Method 'BottomRightCell' not supported by automation object'.
---------------------------
Break Continue Help
---------------------------

Wie komme ich an die Koordinaten entweder als Zahlen(6,9) oder als Zelle(F9) ran ? Gibt es noch andere Properties ? Ich habe bis jetzt keine gefunden.

Edit:
Zum besseren Nachvollziehen, habe ich mal einen Teil der der Spalten als Bild angehängt. Jedes kleine Rechteck ist ein Textfeld und keine Textbox. Diese Heißen alle mit Namen "Text Box xxxx". Hierbei stehen die xxxx für unterschiedliche Zahlen.

[Jumpy]

Ich hab gerade mal versucht, das nachzustellen und es scheint, als wärest du weiter gekommen als ich:

Ich komme dabei noch an die Shapes-Auflistung, kann mir also per showmessage noch ws.Shapes.Count ausgeben lassen, an die Shapes komme ich dann aber schon nicht dran:

ws.Shapes[i] gibt einen ungültiges Argument Fehler

ws.Shapes.Item[i] gibt ein "mitglied wurde nicht gefunden" Fehler.

Kann nicht am Index liegen, da ich beide Varianten (Start mit0 und mit 1 probiert habe).

Mystriös.

[RWarnecke]

Zitat:

Zitat von Jumpy (Beitrag 1176261)

Ich komme dabei noch an die Shapes-Auflistung, kann mir also per showmessage noch ws.Shapes.Count ausgeben lassen, an die Shapes komme ich dann aber schon nicht dran:

ws.Shapes[i] gibt einen ungültiges Argument Fehler

ws.Shapes.Item[i] gibt ein "mitglied wurde nicht gefunden" Fehler.

Nimm mal Range statt Item. Dann kommst Du an den Namen und an die Werte Top und Left. Mit Textframe.Characters.Text kommst Du an den Inhalt des Textfeldes.

[Elvis]

Da ich hier kein Delphi habe, hab ich's gerade mal schnell mit VBA und dann in LinqPad (C#) probiert:

Code:

var appType = Type.GetTypeFromProgID("Excel.Application");
dynamic excelApp = Activator.CreateInstance(appType);
var workBook = excelApp.Workbooks.Open(@"jadajada\Excel-Controls Test.xlsx");

var msoTextBox = 12;
var msOLEControlObject = 19;

var activeSheet = workBook.ActiveSheet;

Func<string, string> cleanCellAddress =
   cellAddress => cellAddress != null
                     ? cellAddress.Replace("$", "")
                     : null;

var shapes = (from dynamic shape in (IEnumerable)activeSheet.Shapes
               where shape.Type == msoTextBox
                     || (shape.Type == msOLEControlObject && shape.OLEFormat.progID.Contains("TextBox"))
               select new
               {
                  Name = (string)shape.Name,
                  TopLeftCell = cleanCellAddress(shape.TopLeftCell.Address as string),
                  BottomRightCell = cleanCellAddress(shape.BottomRightCell.Address as string),
                  AllCells = (from dynamic cell in (IEnumerable)excelApp.Range(shape.TopLeftCell, shape.BottomRightCell).Cells
                              select cleanCellAddress(cell.Address as string)).ToList()
               }).ToList();

Dynamic entpricht Delphi's OleVariant.
Die Funktionen, die man so freizügig in VBA nutzen kann, kann man einfach direkt auf dass Excel.Application-Objekt anwenden. (Ich nutze in dem Beispiel die Range-Funktion)
Wenn ihr Textboxes haben wollt, dann könnt ihr nicht auf den Namen gehen, den kann man ändern!
Es gibt einen Type bei den Shapes, der kann 12 sein (TextBox) oder 19 (Ein OLE Control das eine Textbox darstellt).
Wenn 19, dann muss man die ProgId prüfen, ob es auch eine TextBox ist.

Falls BottomRightCell erst in späteren Excel-Version dazukam, kann man halt nur Links-oben nutzen...

[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 :

Delphi-Quellcode:

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:

Zitat von RWarnecke (Beitrag 1176400)

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 :mrgreen: 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:

Zitat von Elvis (Beitrag 1176476)

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.