Shapes und InlineShapes ansprechen |
|
|||||||||||||||||||||
Grafiken kann man in Word auf zwei Arten in ein Dokument einfügen:
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 ). 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
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. 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) |