Discussion :

[hottis]

Bonour
voilà mon problème , j'ai un classeur excel qui contient de multiples onglets ( c'est variable entre 10 et 30 à peu près ), je dois changer un logo A( image .jpg ) par un logo B ( aussi une image .jpg ) sur chaque onglet, le souci est que d'un onglet à l'autre le positionnement du logo A n'est pas le même ainsi que la taille du logo, ce qui veut dire que lorsque je remplace le logo A par le logo B, un coup il est bien centré par rapport à l'origine ou bien il est décentré et trop petit ou trop grand, avez vous une solution pour ça ??

[BlueMonkey]

Bonjour,

Bienvenue sur le forum.

Pour remplacer un logo A par un logo B sur toutes les feuilles du classeur, en conservant la taille et position spécifique sur chaque feuille du logo A.

Code :

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

1
2
3
4
5
6
7
Private Sub CommandButton1_Click()
    Dim ws As Worksheet
 
    For Each ws In Worksheets
        Call LoadPict(ws, "LogoA", "C:\Documents and Settings\My Documents\Images\LogoB.jpg")
    Next ws
End Sub

Vérifie qu'il y a bien une image sur la feuille.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
Private Function DoesPictExist(ws As Worksheet, PictName As String) As Boolean
    DoesPictExist = False
 
    Dim p As Object
    For Each p In ws.Pictures
        If p.Name = PictName Then
            DoesPictExist = True
            Exit For
        End If
    Next p
End Function

Supprime l'image existante, et la remplace par l'image contenu dans le fichier "filename", en conservant la taille et position de l'image précédente.

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
Private Sub LoadPict(ws As Worksheet, PictName As String, filename As String)
    Dim l As Integer, t As Integer, w As Integer, h As Integer
 
    If DoesPictExist(ws, PictName) Then
        With ws.Pictures(PictName)
            l = .Left
            t = .Top
            w = .Width
            h = .Height
            .Delete
        End With
 
       With ws.Pictures.Insert(filename)
           .Name = PictName
           .Left = l
           .Top = t
           .Width = w
           .Height = h
       End With
 
    End If
 
End Sub

Ce code est basé sur le principe que l'image et nommée.
Mais en appelant la propriété Pictures(<index de l'image>)

[BlueMonkey]

Bonjour,

En MP vous vous privez du support et avis de tous les membres du forum.
Le mieux est toujours de poster vos questions techniques sur le forum.
(Et en général les MP Technique finissent )
Merci de votre compréhension.

Bonjour

pour infos voilà ce que j'avais fait, ça fonctionnait plutôt bien , mise à part la taille des images insérer (logo B) ne respectait pas la taille initiale du logo A.

'suppression du logo A

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
Application.ScreenUpdating = False
For i = 1 To Sheets.Count
Sheets(i).Activate
 
    Dim Obj As shape
    Dim Plage As Range, PlageDonnees As Range
 
'plage de cellules cible
 
Set PlageDonnees = Range("a1:f4")
 
For Each Obj In ActiveSheet.Shapes
 
    'Position du Shape dans la feuille
    Set Plage = Range(Obj.TopLeftCell.Address & ":" & _
            Obj.BottomRightCell.Address)
 
    If Not Intersect(Plage, PlageDonnees) Is Nothing Then _
        Obj.Delete
 
 
Next Obj
Next i

'insertion du logo B

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
 
Application.ScreenUpdating = False
For i = 1 To Sheets.Count
Sheets(i).Activate
    Range("a2").Select
 
    ActiveSheet.Pictures.Insert( _
        "C:\Users\logo B.jpg" _
        ).Select
 
    Selection.shaperange.ScaleWidth 0.88, msoFalse, msoScaleFromTopLeft
    Selection.shaperange.ScaleHeight 0.88, msoFalse, msoScaleFromTopLeft
    Selection.shaperange.ScaleWidth 0.72, msoFalse, msoScaleFromTopLeft
    Selection.shaperange.ScaleHeight 0.72, msoFalse, msoScaleFromTopLeft
    Selection.shaperange.ScaleWidth 0.98, msoFalse, msoScaleFromTopLeft
    Selection.shaperange.IncrementLeft 18
    Selection.shaperange.IncrementLeft -17.25
    Selection.shaperange.IncrementTop 1.5
    Selection.shaperange.ScaleWidth 1.49, msoFalse, msoScaleFromTopLeft
 
 
Next i

Ok. pour l'insertion logo B, il reste des "Select/Selection" inutile. (résidu de Macro enregistré).

Pour ce qui est du problème de la taille du logo B ne respectant pas la taille du logo A, la méthode présenté dans le post précédent
indique comment sauvegarder les informations de taille et position du logo A, avant de le supprimer. (voir la fonction LoadPict)

[hottis]

Bonjour

malheureusement ça ne fonctionne pas avec le code LoadPict

[BlueMonkey]

Bonjour,

malheureusement ça ne fonctionne pas avec le code LoadPict

Qu'est ce qui ne fonctionne pas ?

Dans cette fonction ,tout n'est peut être pas récupérable.
Ce qui est a garder, au minimum, c'est de récupérer l'emplacement du logo A, avant de le supprimer.
Comme ça tu peut donner les même emplacement au logo B.

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
 
 Dim l As Integer, t As Integer, w As Integer, h As Integer
 
       ' enregistre l'emplacement du logo A, puis le supprime 
        With ws.Pictures(<logo A>) ' ou  ws.Pictures(1)  s'il n'y a qu'une image dans l'onglet
            l = .Left
            t = .Top
            w = .Width
            h = .Height
           .Delete
        End With
 
       ' insert logo B à l'emplacement du logo A
       With ws.Pictures.Insert(<nom du logo B>)
           .Left = l
           .Top = t
           .Width = w
           .Height = h
       End With

[hottis]

Bonjour

c'est plus compliqué que cela , en effet j'ai bien visuellement une image identique sur chaque onglet, mais la taille change et le nom de l'image n'est pas le même, sur l'onglet 1 je vais avoir une image "picture 50 " , sur l'onglet 2 "picture 12" et ainsi de suite.

Je ne peut donc pas considérer que le nom des images est toujours le même.

En plus je peut avoir plusieurs image sur un onglet , il s'agit de dossier de fabrication , il y a de multiples images sur un onglet

voiçi un exemple d'onglet tel qu'ils peuvent etre dans le fichier

c'est le logo "TES" en haut à gauche qui est à remplacer par un autre