Gestion Images en VBA

Bonjour à tous,

J'essaie de placer des images sur ma feuille excel. J'ai "reussi" en prenant des bouts de code en fouillant sur le net, ça fonctionne très bien sur la feuille active mais j'aimerais l'appliquer à plusieurs feuilles en même temps, j'imagine que ce sont les ActiveSheet qui bloquent mais je ne sais pas par quoi les remplacer? Il y en a 2 : un pour une boucle qui efface les images précédentes "For Each Pic In ActiveSheet.Pictures Pic.Delete" et l'autre avec un With. Auriez-vous une solution svp? Je mets le code :

Sub Logo()

Dim fl As Worksheet
For Each fl In Worksheets
  If fl.Name = "Match 1" Or fl.Name = "Match 2" Or fl.Name = "Match 3" Or fl.Name = "Match 4" Or fl.Name = "Match 5" Or fl.Name = "Match 6" Or fl.Name = "Match 7" Or fl.Name = "Match 8" Or fl.Name = "Match 9" Or fl.Name = "Match 10" Then

EquDom = Range("b34").Value
EquExt = Range("af34").Value
Stade = Range("b34").Value & "Stade"
LogoGauche = Range("b34").Value & "Gauche"
LogoDroit = Range("af34").Value & "Droit"

LogoNormal = "C:\Users\INDUS PROD\Desktop\OM\Graphiques\Logo\Logo normal"
DossierStade = "C:\Users\INDUS PROD\Desktop\OM\Graphiques\Stade"
DossierLogoGauche = "C:\Users\INDUS PROD\Desktop\OM\Graphiques\Logo\Logo gauche"
DossierLogoDroit = "C:\Users\INDUS PROD\Desktop\OM\Graphiques\Logo\Logo droit"

Set cDom = Range("f3:l31")
Set cExt = Range("aj3:ap31")
Set cStade = Range("p33:af75")
Set cGauche = Range("b41:y73")
Set cDroit = Range("w41:at73")

Dim Pic As Object
For Each Pic In ActiveSheet.Pictures
Pic.Delete
Next Pic

With ActiveSheet

'Logo normal équipe domicile
    .Pictures.Insert(LogoNormal & "\" & EquDom & ".png").Name = EquDom
    .Shapes(EquDom).Left = cDom.Left
    .Shapes(EquDom).Top = cDom.Top
    .Shapes(EquDom).LockAspectRatio = msoFalse
    .Shapes(EquDom).Height = cDom.Height
    .Shapes(EquDom).Width = cDom.Width

'Logo normal équipe extérieure
    .Pictures.Insert(LogoNormal & "\" & EquExt & ".png").Name = EquExt
    .Shapes(EquExt).Left = cExt.Left
    .Shapes(EquExt).Top = cExt.Top
    .Shapes(EquExt).LockAspectRatio = msoFalse
    .Shapes(EquExt).Height = cExt.Height
    .Shapes(EquExt).Width = cExt.Width

'Stade
    .Pictures.Insert(DossierStade & "\" & Stade & ".jpg").Name = Stade
    .Shapes(Stade).Left = cStade.Left
    .Shapes(Stade).Top = cStade.Top
    .Shapes(Stade).LockAspectRatio = msoFalse
    .Shapes(Stade).Height = cStade.Height
    .Shapes(Stade).Width = cStade.Width

'Logo Gauche
    .Pictures.Insert(DossierLogoGauche & "\" & LogoGauche & ".png").Name = LogoGauche
    .Shapes(LogoGauche).Left = cGauche.Left
    .Shapes(LogoGauche).Top = cGauche.Top
    .Shapes(LogoGauche).LockAspectRatio = msoFalse
    .Shapes(LogoGauche).Height = cGauche.Height
    .Shapes(LogoGauche).Width = cGauche.Width

'Logo Droit
    .Pictures.Insert(DossierLogoDroit & "\" & LogoDroit & ".png").Name = LogoDroit
    .Shapes(LogoDroit).Left = cDroit.Left
    .Shapes(LogoDroit).Top = cDroit.Top
    .Shapes(LogoDroit).LockAspectRatio = msoFalse
    .Shapes(LogoDroit).Height = cDroit.Height
    .Shapes(LogoDroit).Width = cDroit.Width

End With

  End If
Next fl

End Sub

En vous remerciant

Bonjour,

avec

For Each fl In Worksheets

on boucle sur toutes les feuilles .

A chaque itération une nouvelle feuille est "représentée" par la variable f1.

Dans cette boucle on veut utiliser la feuille active. Or, la feuille active on la connait : c'est f1

Donc, en remplaçant ActiveSheet par f1 dans le code ça devrait fonctionner... à tester

A+

Bonjour,

merci pour votre réponse rapide, alors pour le With ça fonctionne, par contre sur cette partie là ça ne fonctionne pas:

Dim Pic As Object
For Each Pic In ActiveSheet.Pictures
Pic.Delete
Next Pic

si je remplace le ActiveSheet.Pictures par fl ou fl.Pictures ça ne marche pas, et si je remplace par WorkSheet ça veut me supprimer toutes les feuilles au lieu des images.

Et j'ai oublié aussi, j'aimerais pouvoir lancer la macro à partir d'une autre feuille qui se nomme "Prochain".

En vous remerciant

Sur le jeux de tests que je me suis créé, ça fonctionne.

Avant d'envisager tout un tas de raisons qui feraient que ça ne fonctionne pas ( erreurs ou ???) par exemple les images ne sont pas des images, utilisation de F1 au lieu de FL ...., il vaudrait mieux déposer un classeur afin de mener des tests

Edit : la macro peut être lancée de n'importe quelle feuille...

Bonjour,

dsl pour le retard j'ai dû refaire mon fichier et je dois donc reprendre mon code du début mais étant une bille en VBA j'avoue que je suis complètement perdu.

Pour résumer la macro doit :

Pour les logos domicile/extérieur :

- Insérer les logos Domicile/Extérieur

-Les redimensionner pour qu'ils fassent 4,5cm de largeur, et avoir un ratio hauteur plus grand de 1,11 par rapport à la hauteur d'origine (exemple avec un logo qui a pour dimension d'origine : 10cm largeur et 15cm hauteur, il devra faire au final faire 4,5cm de largeur pour environ 7,49 de hauteur)

-Les centrer par rapport à des rectangles définis sur les feuilles

Pour le logo diffuseur :

Exactement pareil que pour les logos dom/ext mais avec 2,25cm de largeur

Pour le stade :

l'insérer dans le range "A1:AH20" et le mettre en arrière plan

Et pour finir à chaque exécution de la macro il devra supprimer ces 4 images et les remplacer par les nouvelles en fonction de valeurs récupérées sur les feuilles (NomEquDom ; NomEquExt ; NomStade ; NomDiff).

Voilà j'espère que ce n'est pas trop demandé et complexe à faire, merci beaucoup. Voici la base du code qui a l'air correcte :

Sub Logo()

' Centreur horizontal Logo Domicile : "ZoneTexte 9"
' Centreur horizontal Logo Extérieur : "ZoneTexte 10"
' Centreur horitonzal Diff : "Rectangle 3"

Dim fl As Worksheet

For Each fl In Worksheets
  If fl.Name = "Match 1" Or fl.Name = "Match 2" Or fl.Name = "Match 3" Or fl.Name = "Match 4" Or fl.Name = "Match 5" Or fl.Name = "Match 6" Or fl.Name = "Match 7" Or fl.Name = "Match 8" Or fl.Name = "Match 9" Or fl.Name = "Match 10" Then

  DossierLogo = "C:\Users\INDUS PROD\Desktop\Ligue 1\Graphiques\Logo"
  DossierStade = "C:\Users\INDUS PROD\Desktop\Ligue 1\Graphiques\Stade"
  DossierDiff = "C:\Users\INDUS PROD\Desktop\Ligue 1\Graphiques\Diffuseur"

  NomEquDom = Range("a42").Value
  NomEquExt = Range("v42").Value
  NomStade = Range("a42").Value & "_Stade"
  NomDiff = Range("at11").Value

  RatioImage = 1.11  

    With fl    

    End With   

  End If
Next fl    
End Sub

En vous remerciant.