Einzelnen Beitrag anzeigen
Ungelesen 03.11.12, 14:22   #13
istdernickfrei?
Mitglied
 
Registriert seit: Jun 2010
Beiträge: 320
Bedankt: 93
istdernickfrei? leckt gerne myGully Deckel in der Kanalisation! | 369257 Respekt Punkteistdernickfrei? leckt gerne myGully Deckel in der Kanalisation! | 369257 Respekt Punkteistdernickfrei? leckt gerne myGully Deckel in der Kanalisation! | 369257 Respekt Punkteistdernickfrei? leckt gerne myGully Deckel in der Kanalisation! | 369257 Respekt Punkteistdernickfrei? leckt gerne myGully Deckel in der Kanalisation! | 369257 Respekt Punkteistdernickfrei? leckt gerne myGully Deckel in der Kanalisation! | 369257 Respekt Punkteistdernickfrei? leckt gerne myGully Deckel in der Kanalisation! | 369257 Respekt Punkteistdernickfrei? leckt gerne myGully Deckel in der Kanalisation! | 369257 Respekt Punkteistdernickfrei? leckt gerne myGully Deckel in der Kanalisation! | 369257 Respekt Punkteistdernickfrei? leckt gerne myGully Deckel in der Kanalisation! | 369257 Respekt Punkteistdernickfrei? leckt gerne myGully Deckel in der Kanalisation! | 369257 Respekt Punkte
Standard

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.
istdernickfrei? ist offline   Mit Zitat antworten