Aktuelle Seite:
/vba/vbafindshapes.htm
Letzte Änderung: 24.06.2006

Getestet unter Word2000Getestet unter WordXPGetestet unter Word2003  
Beispiel anzeigen
Makro/Datei speichern
Print

 

Grafiken kann man in Word auf zwei Arten in ein Dokument einfügen:

  • als InlineShape,
    d.h. die Grafik liegt in der Textebene
  • als Shape,
    d.h. die Grafik liegt außerhalb, meist vor oder hinter der Textebene

Die InlineShapes werden über die Reihenfolge im Text angesprochen. Dazu wird der Index verwendet, über den die InlineShapes auch angesprochen werden:

ActiveDocument.InlineShapes(Index)

Der Index richtet sich dabei immer nach der Position im Text; wird ein neues InlineShape eingefügt, ändert sich der Index für alle nachfolgenden Grafiken. Somit lässt sich nicht erkennen, in welcher Reihenfolge die InlineShapes eingefügt wurden.

Bei den Shapes hingegen verhält es sich genau umgekehrt: Der Index wird in der Reihenfolge des Einfügens vergeben. So kann eine später eingefügte Grafik durchaus einen höheren Index erhalten, wenn sie vor anderen Grafiken im Dokument eingefügt wird.

Ursache hierfür ist die Verankerung der Shapes: Sobald sie nicht im Fließtext liegen, erhalten Sie einen Verankerungspunkt (erkennbar am Anker-Symbol Anker). Dieser Ankerpunkt liegt in der Textebene und meist am Anfang des Absatzes, in dem sich die Einfügemarke befand, als die Grafik eingefügt wurde.

Möchte man aber die Shapes in der Reihenfolge ansprechen, in der sie im Dokument angeordnet sind, so kann man nicht pber den Index zugreifen, sondern muss den Ankerpunkt auswerten und mit den anderen Ankern vergleichen.

Das folgende Beispiel zeigt, wie man auf diesem Weg das erste Shape markieren kann. Dazu wird zuerst das erste Shape (laut Index) als shpFirst-Shape festgelegt. Anschließend werden der Reihe nach die Ankerpositionen der weiteren Shapes mit diesem verglichen. Das Shape mit dem jeweils weiter zum Anfang liegenden Ankerpunkt wird dann als neues shpFirst-Shape festgelegt. Dadurch verschiebt sich die Markierung immer weiter zum Dokumentanfang, bis das erste Shape gefunden ist.

Sub SelectFirstShapePosition()  
Dim shp As Shape, shpFirst  As Shape  
If ActiveDocument.Shapes.Count > 0 Then  
  Set shpFirst = ActiveDocument.Shapes(1)  
Else  
 Exit Sub  
End If  
For Each shp In ActiveDocument.Shapes  
  With shp  
    If .Anchor.Start < shpFirst.Anchor.Start Then  
      Set shpFirst = shp  
    End If  
  End With  
Next shp  
shpFirst.Select  
Set shp = Nothing  
Set shpFirst = Nothing  
End Sub 


Möchte man ein bestimmtes Shape in Bezug auf seine Position ansprechen, so reicht obiges Makro nicht aus, da damit nur das erste im Dokument ermittelt wird. Um ein beliebes Shape zu markieren, kann man die Positionen aller Shapes einlesen und sortieren. Wenn man den Shape-Index mitsortieren lässt, kann man anschließend über den Index das gewünschte Shape ansprechen.

Die nachfolgende Funktion  SelectShapePosition kapselt genau diese Funktion. Dazu werden zuerst alle Ankerpositionen der Shapes in ein Array eingelesen und mittels der Hilfsfunktion  fkt_ArrSort sortiert.
Als Übergabeparameter an die Funktion werden die gewünschte Shape-Position und die Anzahl der Shapes mit im Aufruf angegeben.
Als Rückgabe liefert die Funktion einen Objektverweis auf das angegebene Shape zurück.

Function SelectShapePosition(oDoc As Document, iPos As Integer, iCount As Integer) As Shape  
If oDoc.Shapes.Count = 0 Or iPos > iCount Or iPos <= 0 Then  
 Set SelectShapePosition = Nothing  
 Exit Function  
End If  
Dim shp As Shape, shpArr() As Variant  
Dim iTemp As Variant  
Dim i As Integer  
    
ReDim shpArr(1, 0)  
ReDim shpArr(1, iCount - 1)  
For i = 1 To iCount  
  shpArr(0, i - 1) = oDoc.Shapes(i).Anchor.Start  
  shpArr(1, i - 1) = i  
Next i  
fkt_ArrSort shpArr(), LBound(shpArr(), 2), UBound(shpArr(), 2)  
Set SelectShapePosition = oDoc.Shapes(shpArr(1, iPos - 1))  
End Function  

Wird allerdings eine Shape-Position angegeben, die im Dokument nicht vorkommt, so wird Nothing zurückgegeben. Damit dies nicht zu einer Fehlermeldung führt, muss der Rückgabewert erst dahingehend überprüft werden.

Das folgende Aufrufbeispiel berücksichtigt genau diese Möglichkeit.

Sub AufrufBeispiel_Shapes()  
Dim shp As Shape  
Set shp = SelectShapePosition(ActiveDocument, 2, ActiveDocument.Shapes.Count)  
If Not shp Is Nothing Then  
  shp.Select  
End If  
End Sub  

Über die nachstehende Sortierfunktion werden die Einträge im Array sortiert und das sortierte Array zurückgeliefert.

Function fkt_ArrSort(shpArr() As Variant, Optional ByVal vStart As Variant, _  
  Optional ByVal vEnd As Variant)  
Dim i As Long
Dim j As Long
Dim hArr As Variant, h0Arr As Variant
Dim iTemp As Variant
i = vStart: j = vEnd
iTemp = shpArr(0, (vStart + vEnd) / 2)
  ' Array aufteilen  
  Do
    While (shpArr(0, i) < iTemp): i = i + 1: Wend
    While (shpArr(0, j) > iTemp): j = j - 1: Wend
    If (i <= j) Then
      ' Wertepaare miteinander tauschen  
      hArr = shpArr(1, i)
      h0Arr = shpArr(0, i)
      shpArr(0, i) = shpArr(0, j)
      shpArr(1, i) = shpArr(1, j)
      shpArr(1, j) = hArr
      shpArr(0, j) = h0Arr
      i = i + 1: j = j - 1
    End If
  Loop Until (i > j)
  If (vStart < j) Then fkt_ArrSort shpArr(), vStart, j
  If (i < vEnd) Then fkt_ArrSort shpArr(), i, vEnd
End Function  

 www.chf-online.de/vba/vbafindshapes.htm © 2001-11 Christian Freßdorf (Zaphod-Systems)