VBA Positionnement plusieurs images dans leur cellule

[Mathar]

Bonjour à tous,

Je bloque sur une macro de positionnement de toutes les images d'une colonne sur le bord gauche de leur cellule. Basé sur d'autre macros similaires, j'ai pu établir le code ci-dessous, il bloque malheureusement à la ligne indiquée (forcément la plus importante). Le but étant de sélectionner les images une à unes et de leur appliquer cette mise en forme.

Sub colonneImage()

Dim Y As Integer
With ActiveSheet
Y = Range("A65536").End(xlUp).Row
End With

Dim Sh As Shape
With ActiveSheet
   For Each Sh In .Shapes
       If Not Application.Intersect(Sh.TopLeftCell, .Range("B1:B" & Y)) Is Nothing Then
         If Sh.Type = msoPicture Then Sh.Select
          With Selection.ShapeRange
        .LockAspectRatio = msoFalse
        .Left = Emplacement.Left ' BLOQUANT!!!!
          End With
       End If
    Next Sh
End With

End Sub

Bien sur si vous avez un moyen d'appliquer la mise en forme sur toutes les images de la colonne directement, cela me conviendrai encore plus.

Merci d'avance!

 

[Mathar]

Re : VBA Positionnement plusieurs images dans leur cellule

pas de solution envisageable?

 

[Papou-net]

Re : VBA Positionnement plusieurs images dans leur cellule

Bonjour Mathar,

Il est rarement facile d'analyser une portion de code sans connaître la structure du fichier.

Que représente l'objet Emplacement, par exemple?

A +

Cordialement.

 

[Mathar]

Re : VBA Positionnement plusieurs images dans leur cellule

Bonjour Papou-net,

Je n'ai pas le fichier sur ce poste, je l'ajouterai en rentrant. Mais en gros la colonne B est constitué en majorité d'images. Elles ne sont pas bien ajustées en largeur, je veux donc sélectionner toutes les images de la colonne B, en définir une largeur (la même pour toutes).

La solution que j'envisage serait de positionner toutes les images sur le côté gauche des cellules "recouvertes" par les images puis de redimensionner la colonne B.

Je joins le fichier dans la soirée.

Cordialement,

EDIT: Fichier joint

 

[Mathar]

Re : VBA Positionnement plusieurs images dans leur cellule

Re,

Peut-on retrouver la position des cellule sur lesquelles les images sont posées à partir de ces dernières?

 

[Si...]

Re : VBA Positionnement plusieurs images dans leur cellule

salut

peut-être ainSi... ,

Sub colonneImage()
  Dim Sh As Shape
  With ActiveSheet
    For Each Sh In .Shapes
      If Not Application.Intersect(Sh.TopLeftCell, [B:B]) Is Nothing Then
        If Sh.Type = msoPicture Then Sh.Select
        With Selection.ShapeRange
          .LockAspectRatio = msoFalse
          .Left = Columns(2).Left
          .Width = Columns(2).Width
        End With
       End If
    Next
  End With
End Sub

 

[Mathar]

Re : VBA Positionnement plusieurs images dans leur cellule

Salut Si...,

C'est parfait merci beaucoup!!!
Pour aller plus loin, peut-on appliquer cette mise en forme à d'autres colonnes de façon dynamique? c'est à dire étendre à la colonne C par exemple ou aux colonnes E et F sans avoir à réécrire ce code plusieurs fois en changeant les noms de colonnes.

Cordialement,

Mathar.

 

[Si...]

Re : VBA Positionnement plusieurs images dans leur cellule

salut

à essayer

Sub colonneImage()
  Dim Sh As Shape, C As Range
  For Each Sh In ActiveSheet.Shapes
    Set C = Intersect(Sh.TopLeftCell, [B:F])  'noms des colonnes avec images ou pas
     If Not C Is Nothing Then
      If Sh.Type = msoPicture Then Sh.Select
      With Selection.ShapeRange
        .LockAspectRatio = msoFalse
        .Left = Columns(C.Column).Left
        .Width = Columns(C.Column).Width
      End With
     End If
  Next
End Sub

 

[Mathar]

Re : VBA Positionnement plusieurs images dans leur cellule

Re,

Merci bien Si..., je pouvais pas espérer mieux

Bonne soirée,

Mathar