Microsoft 365 Image : pourvoir afficher la même image dans tous mes onglet

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour à toutes et à tous,
Je vous souhaite une belle fin de journée :)

J'ai un nouveau problème que je n'arrive pas à solutionner malgré mes recherches et tentatives :mad:
Dans le classeur joint, j'ai une image en Feuil1 (il pourra y en avoir 25) et j'ai un p'tit code qui me permet d'afficher ou de masquer.

Ce que je voudrais (pour ne pas avoir à multiplier les images dans tous les onglets),
Pour chaque fichier de travail,"ma z'usine à gaz" lol, j'ai environ 25 clients traités : 1 photo par Client = 25 photos instructions
que j'ai besoin de pouvoir afficher/masquer dans 3 onglets = 75 photos si obligé de les mettre dans les 3 onglets
:

Est-il possible d'afficher la même image dans tous mes onglets ? ... pas sûr du tout !!! lol
Peut-être en stockant je ne sais où, mais accessible pour tous les onglets ?
ça m'arrangerait bien :)
Auriez-vous la solution ?
Un grand merci par avance,
Amicalement,
lionel :)
 

Pièces jointes

  • Image_Affiche_TsOnglets.xlsm
    224.5 KB · Affichages: 27
Dernière édition:
Solution
En affectant la macro Supprimer à l'image il suffit de cliquer dessus pour la supprimer, fichier (2) :
VB:
Sub Image_Clients1()
Dim c As Range, lig&, s As Shape
Set c = ActiveCell
lig = c.Row
For Each s In ActiveSheet.Shapes
    If s.Name Like "Client*" Then s.Delete
Next
If Not IsNumeric(CStr(Cells(lig, "J"))) Or lig < 7 Then Exit Sub
On Error Resume Next
Sheets("Images").Shapes("Client " & Cells(lig, "J")).Copy
If Err Then MsgBox "L'image " & Cells(lig, "J") & " n'existe pas...": Exit Sub
Cells(lig, "K").Select 'ou ailleurs...
ActiveSheet.Paste
Selection.OnAction = "Supprimer" 'affecte la macro Supprimer
c.Select 'désélectionne l'image
End Sub

Sub Supprimer()
On Error Resume Next
ActiveSheet.Shapes(Application.Caller).Delete
End...

job75

XLDnaute Barbatruc
En affectant la macro Supprimer à l'image il suffit de cliquer dessus pour la supprimer, fichier (2) :
VB:
Sub Image_Clients1()
Dim c As Range, lig&, s As Shape
Set c = ActiveCell
lig = c.Row
For Each s In ActiveSheet.Shapes
    If s.Name Like "Client*" Then s.Delete
Next
If Not IsNumeric(CStr(Cells(lig, "J"))) Or lig < 7 Then Exit Sub
On Error Resume Next
Sheets("Images").Shapes("Client " & Cells(lig, "J")).Copy
If Err Then MsgBox "L'image " & Cells(lig, "J") & " n'existe pas...": Exit Sub
Cells(lig, "K").Select 'ou ailleurs...
ActiveSheet.Paste
Selection.OnAction = "Supprimer" 'affecte la macro Supprimer
c.Select 'désélectionne l'image
End Sub

Sub Supprimer()
On Error Resume Next
ActiveSheet.Shapes(Application.Caller).Delete
End Sub
 

Pièces jointes

  • Image_Affiche_TsOngletsM_forum(2).xlsm
    634.8 KB · Affichages: 7

Discussions similaires

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
312 206
Messages
2 086 219
Membres
103 158
dernier inscrit
laufin