Rotation photos sur une feuille

Question

J'ai un petit soucis avec une macro que j'avais commencé avec l'enregistreur des macros. En fait la macro fonctionne bien quand je sélectionne moi même les photos, je voulais la modifier pour faire tourner toutes les photos qui sont présents sur les colonnes C et D. Mais malheureusement ça ne fonctionne pas. Voici le code qui fonctionne en sélectionnant les photos. Sub Macro1() ' ' Macro1 Macro ' ' Selection.ShapeRange.IncrementRotation 270 Selection.ShapeRange.ScaleHeight 0.8994845361, msoFalse, _ msoScaleFromBottomRight Selection.ShapeRange.ScaleHeight 0.9140410171, msoFalse, msoScaleFromTopLeft Selection.ShapeRange.ScaleWidth 1.0993589744, msoFalse, msoScaleFromTopLeft Selection.ShapeRange.ScaleWidth 1.137025933, msoFalse, msoScaleFromBottomRight End Sub...

clr · Answer

Bonjour Amine,
voici le code qui permet de faire une rotation de 90° pour les images situés entre les colonnes incluses C et D (3 et 4).
Adapter l'angle de rotation et les colonnes souhaitées dans le code.

Sub RotationImages()
Dim s As Shape
    For Each s In ActiveSheet.Shapes()
        If s.Type = msoPicture And (s.TopLeftCell.Column >= 3 Or s.TopLeftCell.Column <= 4) Then
            s.IncrementRotation 90
        End If
    Next
    Set s = Nothing
End Sub

Abderrahmane BENALI · Answer

Bonjour à tous,

Un code à tester :

Sub Macro1()
'
' Macro1 Macro
'
Dim ws As Worksheet
Dim rng As Range
Dim pic As Picture
Dim cell As Range

Set ws = ActiveSheet 'Feuille où vous avez vos photos
Set rng = ws.Range("C:D") 'Modifiez cette valeur en fonction de la plage que vous souhaitez couvrir

'Boucle sur toutes les cellules de la plage
For Each cell In rng
    'Passer en boucle chaque image de la feuille de travail
    For Each pic In ws.Pictures
        'Si le coin supérieur gauche de l'image se trouve à l'intérieur de la cellule, faites-la pivoter et mettez-la à l'échelle.
        If cell.Top <= pic.Top And cell.Left <= pic.Left And _
            cell.Top + cell.Height >= pic.Top And cell.Left + cell.Width >= pic.Left Then

            pic.ShapeRange.IncrementRotation 270
            pic.ShapeRange.ScaleHeight 0.8994845361, msoFalse, msoScaleFromBottomRight
            pic.ShapeRange.ScaleHeight 0.9140410171, msoFalse, msoScaleFromTopLeft
            pic.ShapeRange.ScaleWidth 1.0993589744, msoFalse, msoScaleFromTopLeft
            pic.ShapeRange.ScaleWidth 1.137025933, msoFalse, msoScaleFromBottomRight
        End If
    Next pic
Next cell

End Sub