Hi,
ich habe jetzt ein wenig herumversucht und es läuft gar nicht mal so schlecht. Das hier habe ich gebastelt und es funktioniert im Prinzip.
Code:
Sub resizePicsOverviewslide()
Dim pres As Presentation
Dim slid As Slide
Dim sCount As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim checkedForResize As Boolean
Set pres = ActivePresentation
sCount = pres.Slides.Count
With pres
For i = 1 To sCount
Set slid = pres.Slides(i)
For j = 1 To slid.Shapes.Count
If slid.Shapes(j).HasTextFrame = True Then
If Right(slid.Shapes(j).TextFrame.TextRange, 8) = "overview" Then
'MsgBox "Slide " & i & ", shape " & j & ": " & slid.Shapes(j).TextFrame.TextRange
For k = 1 To slid.Shapes.Count
If Left(slid.Shapes(k).Name, 7) = "Picture" Then
If slid.Shapes(k).Left < 300 Then
'resize
slid.Shapes(k).LockAspectRatio = msoTrue
slid.Shapes(k).Height = 36.85
End If
End If
Next k
checkedForResize = True
End If
If checkedForResize = True Then
checkedForResize = False
GoTo BailOut
End If
End If
Next j
BailOut:
Next i
End With
End Sub
Ich vermute es ist sehr viel umständlicher als nötig und es geht auch einfacher...? Aber nichtsdestotrotz, es geht ja!
Nur eine Sache: ich müsste die Bilder auf eine Maximalhöhe und Maximalbreite einstellen. Die Maximalhöhe ist 1,3 cm, so ist es grade auch im Makro eingestellt. Dadurch dass die Seitenverhältnisse beibehalten werden soll (LockAspectRatio) stellt er die Breite automatisch ein. Aber was wenn ich auch in der Breite ein Maximum haben möchte? Das Bild darf maximal 1,3cm hoch und maximal 2,7cm breit werden, je nach dem was der Fall ist. Es soll halt nich passieren, dass das Bild ohne dass die Seitenverhältnisse beachtet werden auf die fixe Größe von 1,3 x 2,7 resized wird.