Discussion :

[GroFlo]

Bonjour à tous,

j'ai un classeur avec un grand nombre de feuilles qui sont presque toutes sur le même modèle, à savoir une image collée en haut à gauche de la feuille. Détail important, c'est la seule image de la feuille. C'est toujours la même image, elle est normalement toujours au même endroit.
Autant je sais parcourir les feuilles et effacer toutes les shapes qui seraient des images, autant j'ai plus de mal pour voir comment je peux automatiser le remplacement de cette image par une autre, qui devrait être au même endroit et faire la même taille.

J'ai pensé à une solution qui partirait d'une première feuille déjà « équipée » d'une image à jour que je pourrais ensuite coller sur chaque feuille, mais j'ai du mal à rédiger le code ni même à savoir comment lui dire où la coller facilement.

Des idées ?

Merci par avance.

[Marc-L]

Bonjour,

lire d'abord les propriétés de l'image existante : dimensions, position, …
La supprimer ensuite puis insérer la nouvelle image et lui appliquer les propriétés de l'image précédente par exemple …

Consulter aussi l'aide VBA intégrée concernant les méthodes PickUp et Apply.

[GroFlo]

Merci, je ne connaissais pas Pickup et Apply, ça pourra servir.
Mais l'enjeu était surtout de pouvoir placer l'image exactement à la même position que la précédente, plus que de la remettre à la même taille. En farfouillant les propriétés et autres, j'ai pu arriver à ce que je voulais. C'est peut être pas le code le plus optimisé qui soit, mais ça a fonctionné, je le mets ici, si ça peut en aider certains lors d'une future recherche.
Pour information, j'ai commencé en mettant l'ancienne image dans une feuille 1 au bon emplacement, puis la nouvelle (à la bonne taille) dans une feuille 2, puis mes feuilles à modifier commençaient à la feuille 4.

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
26
27
28
29
30
31
32
33
34
35
36
37
Sub CopieLogo()
    Dim sh As Shape
    Dim hauteur, largeur, ws, ws_count
 
    For Each sh In Worksheets("FA Logo").Shapes 'mémoriser l'emplacement du logo sur la feuille
        If sh.Type = msoPicture Then
            hauteur = sh.Top
            largeur = sh.Left
 
        End If
    Next
 
    ws_count = Sheets.Count
 
    For ws = 4 To ws_count 'effacer toutes les images sur les feuilles concernées
 
        Sheets(ws).Select
 
        For Each sh In Worksheets(ws).Shapes
            If sh.Type = msoPicture Then sh.Delete
        Next
    Next
 
    Sheets(2).Shapes("Image 1").Copy 'copier l'image nouvelle
 
    For ws = 4 To ws_count
        Sheets(ws).Select
        ActiveSheet.Paste
 
        For Each sh In Worksheets(ws).Shapes
            If sh.Type = msoPicture Then
                sh.Top = hauteur
                sh.Left = largeur
            End If
        Next
    Next
End Sub