Positionner une image dans cellule

Version imprimable

11/03/2021, 21h16
retraite83

Positionner une image dans cellule

Bonjour,

j'ai des images dans les cellules d'une colonne d'une feuille, une image par cellule

Je veux que ces images soit en haut à gauche, le problème est qu'elles sont pas toujours bien positionné à qq pixels près

Je ne sais pas comment m'y prendre pour être sur de sélectionner l'image quelque soit sa position réelle dans la cellule pour pouvoir la repositionner
11/03/2021, 22h38
anasecu

Bonjour,

Citation:

Envoyé par retraite83

Je veux que ces images soit en haut à gauche, le problème est qu'elles sont pas toujours bien positionné à qq pixels près

Si tu les positionne manuellement, il te suffit d'utiliser la touche Alt enfoncée et avec la souris ton image se cale sur les bords choisis de la cellule
12/03/2021, 09h33
retraite83

Bonjour,

j'ai beaucoup d'images et certaines sont décalées. Je souhaite faire un macro que j'utilise de temps en temps pour recadrer si besoin l'image en haut à gauche dans chaque cellule

Je vais essayer en balayant les shapes sur la colonne et en les positionnant une par une. Je cherche sur les forums car je n'ai jamais vu cela encore

Bonjour,

En "balayant" les formes :
(adapter colonne et nom feuille)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Option Explicit
Sub ImageEnHautGauche()
Dim cel As Range
Dim forme As Shape
Const col$ = "C"
 
  With Worksheets("Feuil1")
    For Each forme In .Shapes
      If forme.Type = msoPicture Then
        Set cel = Intersect(forme.TopLeftCell, .Columns(col))
        If Not cel Is Nothing Then
          forme.Top = cel.Top
          forme.Left = cel.Left
        End If
      End If
    Next forme
  End With
 
End Sub

12/03/2021, 10h43
retraite83

Bonjour Patrice
et encore une fois merci

J'étais en train de bricoler qq chose qui ressemble à ça, mais jamais au grand jamais je n'aurai abouti...

Une fois adapté (facile quand même ça...) c'est parfait.

Juste une remarque de mon niveau j'aurais appelé la macro

Code:

Sub ImageEnHautGauche()

:chin:

bonjour, j'ai finalement :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Const colS$ = "C" ' colonne photo With Worksheets(ps) For Each forme In .Shapes If forme.Type = msoPicture Then Set cel = Intersect(forme.TopLeftCell, .Columns(colS)) If Not cel Is Nothing Then forme.Top = cel.Top forme.Left = cel.Left End If End If Next forme End With
Mes photos sont cadrées dans mon fichier, je décale une photo pour tester et j'exécute le code. La photo est recadrée

Cependant j'ai une autre macro qui utilise les propriétés "top" et "left".
Avec le fichier d'origine, le code suivant est ok, après décalge et recadrage de la photo ce code se plante en "erreur 1004"

Après retour arrière plusieurs fois, c'est systématique : ok avant le code de recadrage, erreur 1004 après recadrage
Code:

1 2 3 4 5 6 7 8 9 10 11 12 With catalogue ReDim tabloimage(1 To nblign) For Each shap In .Shapes If shap.TopLeftCell.Row >= 1 And shap.TopLeftCell.Row <= nblign And shap.TopLeftCell.Column = 3 Then i = i + 1: shap.Name = "img" & i ' Rename image tabloimage(shap.TopLeftCell.Row) = shap.Name ' Nom de l'image dans le même index que la ligne où elle se trouve dans le catalogue End If Next ' Copie de tout les shapes en les groupant With .Shapes.Range(tabloimage): .Group.Copy: .Ungroup: End With End With
l'erreur 1004 se produit sur la ligne "With .Shapes.Range(tabloimage): .Group.Copy: .Ungroup: End With"

Aucune idée du pourquoi

Je suis un chercheur qui cherche, je rêve d'être un chercheur qui trouve...

13/03/2021, 17h59
Patrice740

Citation:

Envoyé par retraite83

Cependant j'ai une autre macro qui utilise les propriétés "top" et "left".
...erreur 1004 après recadrage...

- Comme je te l'ai déjà dit plusieurs fois, pour qu'on puisse comprendre, il faut fournir le code complet de la macro.
- Quand une erreur se produit, le numéro ne suffit pas, il y a un message d'erreur qui précise l'erreur (pour un même numéro d'erreur, plusieurs messages existent).
- Le code publié n’utilise pas les propriétés Top et Left !!!!

Bonjour

Après toute une série de test je pense avoir détecter l'endroit de l'erreur ("erreur 1004 Erreur définie par l'application ou l'objet")

Le cadrage à l'air tout à fait correct mais dans ma séquence de mise en forme pour une édition:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 ' Rassemblement des images dans un tableau With catalogue ReDim tabloimage(1 To nblign) For Each shap In .Shapes If shap.TopLeftCell.Row >= 1 And shap.TopLeftCell.Row <= nblign And shap.TopLeftCell.Column = 3 Then i = i + 1: shap.Name = "img" & i ' Rename image tabloimage(shap.TopLeftCell.Row) = shap.Name End If Next ' Copie des shapes en les groupant With .Shapes.Range(tabloimage): .Group.Copy: .Ungroup: End With End With
la macro ne détecte pas d'image dans

Code:

If shap.TopLeftCell.Row >= 1 And shap.TopLeftCell.Row <= nblign And shap.TopLeftCell.Column = 3 Then

et donc lors de la copie des shapes "tabloimage" est vide et plantage

Au plantage nblig = 169 valeur correcte et mes photos sont bien en colonnes "C" = 3, i = 0 ce qui conforte mon hypothèse

Je ne comprends pas pourquoi sans cadrage des photos cela marche sans problème

14/03/2021, 13h25
Patrice740

Citation:

Envoyé par Patrice740

- Comme je te l'ai déjà dit plusieurs fois, pour qu'on puisse comprendre, il faut fournir le code complet de la macro.

Je n'aurais pas utilisé cette méthode ... (voir l'objet ShapeRange)
- et comme dans le code précédent j'aurais vérifié que le shape est une image !
Quand on écrit du code pas suffisamment rigoureux, l'erreur finit par se produire, comme c'est le cas ici.
14/03/2021, 13h31
retraite83

Citation:

Je n'aurais pas utilisé cette méthode

C'est la différence entre un expert et un profane...

Je ne vois pas d'autre autre méthode...

Tu me conseilles de voir du côté d'"Intersect" ?

Re,

Pourtant je te l'ai donnée ....

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub CopierGroupeImages()
Dim cel As Range
Dim forme As Shape
Dim tbImg() As String
Dim i As Long
Const col$ = "C"
 
  With Worksheets("Feuil1")
    For Each forme In .Shapes
      If forme.Type = msoPicture Then
        Set cel = Intersect(forme.TopLeftCell, .Columns(col))
        If Not cel Is Nothing Then
          i = i + 1
          ReDim Preserve tbImg(1 To i)
          tbImg(i) = forme.Name
        End If
      End If
    Next forme
    If i > 0 Then
      Set forme = .Shapes.Range(tbImg).Group
      forme.Copy
      forme.Ungroup
    End If
  End With
End Sub

14/03/2021, 18h44
retraite83

Merci Patrice, c'est ce que j'étais en train d'essayer de faire, mais la syntaxe de VBA reste encore un grand mystère pour moi (et restera)...

J'ai réussi à adapter et c'est bon (le confinement peut avoir du bon...).

J'ai autre chose que j'essaye faire un peu dans le même ordre d'idée mais j'ouvre une autre discussion