Der Befehl
SpatialRelation
ist klasse: damit kann man überprüfen, ob ein Shape in der Nähe eines anderen liegt. Durchläuft man mit einer Schleife alle Shapes, kann man schnell die Nachbarn herausfinden.
Allerdings: ich suche die benachbarten „Regale“ zu den Spirituosen und finde drei Regale (ich suche nur nach den weißen Shapes). Was tun? Also doch ein bisschen x- und y-Rechnung:
For j = 1 To UBound(strShapeNameMitText)
If vsBlatt.Shapes(strShapeNameMitText(j)).Cells(„FillForegnd“).Result(„in“) = 1 Then
If Asc(Left(vsBlatt.Shapes(strShapeNameMitText(j)).Text, 1)) <> 63 Then
If vsBlatt.Shapes(strShapeNameMitText(i)).SpatialRelation(vsBlatt.Shapes(strShapeNameMitText(j)), dblTolerance, visSpatialIncludeHidden) > 0 Then
If CInt(vsBlatt.Shapes(strShapeNameMitText(j)).Cells(„Angle“).Result(„deg“)) = 0 Then ‚ — waagrecht
If (vsBlatt.Shapes(strShapeNameMitText(j)).Cells(„PinX“).Result(„cm“) >= vsBlatt.Shapes(strShapeNameMitText(i)).Cells(„PinX“).Result(„cm“) – _
vsBlatt.Shapes(strShapeNameMitText(i)).Cells(„Width“).Result(„cm“) / 2 And _
vsBlatt.Shapes(strShapeNameMitText(j)).Cells(„PinX“).Result(„cm“) <= vsBlatt.Shapes(strShapeNameMitText(i)).Cells(„PinX“).Result(„cm“) + _
vsBlatt.Shapes(strShapeNameMitText(i)).Cells(„Width“).Result(„cm“) / 2) Then
xlZelle.Offset(lngExcelZeile, 8).Value = vsBlatt.Shapes(strShapeNameMitText(j)).Text
xlZelle.Offset(lngExcelZeile, 9).Value = vsBlatt.Shapes(strShapeNameMitText(j)).Name
lngExcelZeile = lngExcelZeile + 1
blnRegalierung = True
End If
Else
If (vsBlatt.Shapes(strShapeNameMitText(j)).Cells(„PinY“).Result(„cm“) >= vsBlatt.Shapes(strShapeNameMitText(i)).Cells(„PinY“).Result(„cm“) – _
vsBlatt.Shapes(strShapeNameMitText(i)).Cells(„Width“).Result(„cm“) / 2 And _
vsBlatt.Shapes(strShapeNameMitText(j)).Cells(„PinY“).Result(„cm“) <= vsBlatt.Shapes(strShapeNameMitText(i)).Cells(„PinY“).Result(„cm“) + _
vsBlatt.Shapes(strShapeNameMitText(i)).Cells(„Width“).Result(„cm“) / 2) Then
xlZelle.Offset(lngExcelZeile, 8).Value = vsBlatt.Shapes(strShapeNameMitText(j)).Text
xlZelle.Offset(lngExcelZeile, 9).Value = vsBlatt.Shapes(strShapeNameMitText(j)).Name
lngExcelZeile = lngExcelZeile + 1
blnRegalierung = True
End If
End If
End If
End If
End If
Next
