Formen ausrichten

Bild

Betrifft: Formen ausrichten
von: Patrick
Geschrieben am: 07.07.2015 08:48:23

Hallo,
ich habe ein Excelblatt in dem es viele Formen gibt, die nicht richtig am Raster ausgerichtet sind. Dabei kann es sein, dass sie vom Ankerpunkt neben dem Rastermaß liegen, oder die Größe vom Rastermaß abweicht.
Ich möchte ein Makro schreiben mit dessen Hilfe ich mehrere selektierte Objekte automatisch auf Rastermaß bringen und daran ausrichten kann.
Aktuell fasse ich jedes Shape oben links an, vergrößere es um ein Rastermaß, dann verkleinere ich es um ein Rastermaß und dann stimmt es oben links. Das gleiche Spiel natürlich mit unten rechts...
Aus einem älteren Projekt habe ich mir die Codebrocken herausgesammelt mit denen ich Shapes selektieren kann. Allerdings fehlt mir das Wissen bezüglich der richtigen Befehle um die Größe und Position zu verbessern.

Sub Ausrichten()
Dim shaShape As Shape
Dim lngShape As Long
ReDim arrShapes(0)
Dim Rng As Range
Set Rng = Selection
For Each shaShape In ActiveSheet.Shapes
        If shaShape.Visible Then
            If Not Intersect(shaShape.TopLeftCell, Rng) Is Nothing Then
                ReDim Preserve arrShapes(0 To lngShape)
                arrShapes(lngShape) = shaShape.Name
                lngShape = lngShape + 1
                Debug.Print shaShape.Name
            End If
        End If
 
        
    Next shaShape
End Sub

https://www.herber.de/bbs/user/98676.xlsx
Gruß,
Patrick

Bild

Betrifft: AW: Formen ausrichten
von: Raphael H
Geschrieben am: 07.07.2015 09:55:55
Hallo Patrick,
du musst die Shapes nicht erst alle in einem Array auflisten, da du so oder so wissen musst welches Shape wohin gehört, kannst du diese auch direkt platzieren.


Sub Positionieren()
    Dim shp As Shape
    Dim ws As Worksheet
    
    Set ws = Sheets("1.200kU Flax_H")
    
    For Each shp In ws.Shapes
        With shp
            Select Case .Name
                Case "Rectangle 181"
                    .Top = ws.Cells(17, 23).Top
                    .Left = ws.Cells(17, 23).Left
                Case "...."
                    '.....
            End Select
        End With
    Next shp
End Sub
Gruess
Raphael

Bild

Betrifft: AW: Formen ausrichten
von: Patrick
Geschrieben am: 07.07.2015 12:04:07
Hi Raphael,
vielen Dank für die schnelle Antwort.
Deine Lösung setzt allerdings voraus, dass ich immer weiß, welches Rechteck an welche Stelle geschoben werden soll. Mein Problem ist, dass das Rechteck links oben und rechts unten am nähesten Gitternetzknoten ausgerichtet werden soll.
Beispiel:
Wenn ich jetzt noch 10 Kästchen male, müsste ich laut deinem Code noch zehn Cases einfügen.
Ich hätte lieber, dass die Kästchen sich nach dem Makroaufruf am nächsten Gitternetzknoten ausrichten.
Gruß,
Patrick

Bild

Betrifft: AW: Formen ausrichten
von: Raphael H
Geschrieben am: 07.07.2015 16:58:29
Hallo Patrick,
in dem Fall könnte man das Ganze mittels TopLeftCell lösen. Mit der Schleife wird bei jedem Shape der die Position der oberen linken Ecke abgefragt und entsprechend kann man dann ausrichten.


Sub Positionieren()
    Dim shp As Shape
    Dim ws As Worksheet
    
    Set ws = Sheets("1.200kU Flax_H")
    
    For Each shp In ws.Shapes
        With shp
            .Top = shp.TopLeftCell.Top
            .Left = shp.TopLeftCell.Left
        End With
    Next shp
End Sub
Gruess
Raphael

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Formen ausrichten"