Guten Morgen allesamt,
Ich habe folgenden Code zum zentrieren meiner Bilder in einer Exceldatei. Momentan zentriert mir Excel damit sämtliche Bilder in dem Blatt. Nun will ich den code aber nur in einem bestimmten Bereich ausführen (G8:G27), damit die Bilder in einem anderen Blattbereich nicht mit zentriert werden.
Code:
For Each shp In ActiveSheet.Shapes
With shp
.Left = Cells(.BottomRightCell.Row, 7).Left + Cells(.BottomRightCell.Row, 7).Width / 2 - .Width / 2
.Top = Cells(.BottomRightCell.Row, 7).Top + Cells(.BottomRightCell.Row, 7).Height / 2 - .Height / 2
End With
Da ich mit VBA nicht viel Erfahrung habe, hoffe ich hier auf Hilfe!
Danke im Voraus!
Capdo
Danke für die schnelle und hilfreiche Lösung!
Hallo nochmal,
ich bräuchte das ganze auch nochmal für diesen Code:
Code:
With ActiveSheet.Pictures
.ShapeRange.LockAspectRatio = msoTrue
.Height = Range("S3").Height
.Placement = xlMoveAndSize
oder kann man beide Codes irgendwie zusammen zu führen?
Code:
Next
With ActiveSheet.Pictures
.ShapeRange.LockAspectRatio = msoTrue
.Height = Range("S3").Height
.Placement = xlMoveAndSize
'Bilder Zentrieren
For Each shp In ActiveSheet.Shapes
If Not Application.Intersect(Range("p3:p3"), shp.TopLeftCell) Is Nothing Then
With shp
.Left = Cells(.BottomRightCell.Row, 16).Left + Cells(.BottomRightCell.Row, 16).Width / 2 - .Width / 2
'.Top = Cells(.BottomRightCell.Row, 16).Top + Cells(.BottomRightCell.Row, 16).Height / 2 - .Height / 2
End With
End If
Next shp
Schöne Grüße,
Yann
Ich habe es jetzt noch etwas probiert aber komme nicht weiter.
Meine Idee war es den Befehl
Code:
If Not Application.Intersect(Range("F7:F16"), shp.TopLeftCell) Is Nothing Then
wiederum vor den Befehl den ich beschränken will zu setzen. Nun sieht der Code so aus:
Code:
If Not Application.Intersect(Range("F7:F16"), shp.TopLeftCell) Is Nothing Then
With ActiveSheet.Pictures
.ShapeRange.LockAspectRatio = msoTrue
.Height = Range("S19").Height
.Placement = xlMoveAndSize
End With
End If
Ich bekomme aber nun die Fehlermeldung "Laufzeitfehler 91: Objektvariable oder With-Blockvariable nicht festgelegt"
Kann mir jemand sagen was ich falsch mache?
Hey Uwe,
Danke kommt weiterhin die gleiche Fehlermeldung. Ich poste hier einmal meinen gesamten Code, vielleicht liegt der Fehler auch irgendwo anders? Ohne diese Beschränkung funktioniert der Code jedoch ohne Probleme nur dass halt alle Bilder in der Mappe der Größe angepasst werden, was ich aber nicht will.
Code:
Sub Bilder_einfügenTeamCars()
Dim wksA As Worksheet
Dim shpX As Shape
Dim rngTopLeftCell As Range
Dim rngZuLoeschenderBereich As Range
Set wksA = ActiveWorkbook.Worksheets("Championship Team")
Set rngZuLoeschenderBereich = wksA.Range("F7:F16")
For Each shpX In wksA.Shapes
Set rngTopLeftCell = shpX.TopLeftCell
If Not Application.Intersect(rngZuLoeschenderBereich, rngTopLeftCell) Is Nothing Then
shpX.Delete
End If
Next
Dim Pfad As String, Wiederholungen As Long
Dim shp As Shape
Dim x As Double
Dim y As Double
Pfad = "Speicherort"
For Wiederholungen = 7 To 16
Cells(Wiederholungen, 6).Activate
ActiveSheet.Pictures.Insert(Pfad & Cells(Wiederholungen, 6) & ".png").Select
Next
If Not Application.Intersect(Range("F7:F16"), shp.TopLeftCell) Is Nothing Then
With shp
.ShapeRange.LockAspectRatio = msoTrue
.Height = Range("S19").Height
.Placement = xlMoveAndSize
End With
End If
For Each shp In ActiveSheet.Shapes
If Not Application.Intersect(Range("F7:F16"), shp.TopLeftCell) Is Nothing Then
With shp
.Left = Cells(.BottomRightCell.Row, 6).Left + Cells(.BottomRightCell.Row, 6).Width / 2 - .Width / 2
.Top = Cells(.BottomRightCell.Row, 6).Top + Cells(.BottomRightCell.Row, 6).Height / 2 - .Height / 2
End With
End If
Next shp
End Sub
Bitte entschuldigt falls der Code irgendwie Chaotisch wirkt, ich habe mir das meiste zusammen gegoogled bzw. erfragt
Hallo,
ist auch irgendwie doof, wenn die betreffenden Shapes in der ersten Schleife des Makros gelöscht werden.
Gruß Uwe
Das liegt daran, dass ich die shapes immer neu rein lade. Es geht darum, dass ich eine Tabelle für eine F1 Liga erstellen will und die Teamlables sich dem Fahrer anpassen. Daher lösch ich die Bilder zuerst bevor ich sie wieder neu an der richtigen Position wieder rein lade, was dann in der nächsten Schleife passiert bevor die Größe und Position dieser angepasst werden.
Gruß Yann
Alles klar. Dann mach ich jetzt mal den Hajo.
