Discussion :

[retraite83]

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

[anasecu]

Bonjour,

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

[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

[Patrice740]

Bonjour,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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 :

Sélectionner tout - Visualiser dans une fenêtre à part

Sub ImageEnHautGauche()

[retraite83]

bonjour, j'ai finalement :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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...

[Patrice740]

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 !!!!

[retraite83]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

       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

[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.

[Patrice740]

Re,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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