Afficher une image selon nom de page

Bonsoir, et meilleur vœux a tous.

Voila j'ai plusieurs page intitulé 500, 501, 503, .... créer selon un modèle.

et un dossier a la racine de la cle usb qui contient des photos intituler 500, 501, 503, .... en jpg

dans ces page en B357 par exemple je souhaiterai qu'il m'affiche une image qui porte le même nom que la page en cour

donc en page 500 il m'affiche 500.jpg

501 il m affiche 501.jpg

est ce possible et si oui comment?

merci pour tous.

Bonsoir,

à inserer dans le code de chaque feuille

Private Sub Worksheet_Activate()
  répertoirePhoto = ThisWorkbook.Path & "\" ' Adapter
  nom = ActiveSheet.Name
  ActiveSheet.Pictures.Insert(répertoirePhoto & nom & ".jpg").Name = nom
  ActiveSheet.Shapes(nom).Left = [B357].Left
  ActiveSheet.Shapes(nom).Top = [B357].Top
End Sub

Merci je souhaite prendre se code pour qui boucle toutes les pages dont le nom est un nombre

Sub InsertPhoto()
For Each sh In Worksheets
    If IsNumeric(sh.Name) Then
    répertoirePhoto = ThisWorkbook.Path & "d:\Photo\" ' Adapter
 nom = ActiveSheet.Name
  ActiveSheet.Pictures.Insert(répertoirePhoto & nom & ".jpg").Name = nom
  ActiveSheet.Shapes(nom).Left = [B1].Left
  ActiveSheet.Shapes(nom).Top = [B1].Top
  End If
  Next
End Sub

mais j ai une erreur

impossible de lire la propriété insert de la classe pictures

a cette ligne

ActiveSheet.Pictures.Insert(répertoirePhoto & nom & ".jpg").Name = nom

désolé de vous importuner je suis vraiment débutant en vba mais se code me faciliterait bien la vie

Bonsoir, essaye ça

Sub InsertPhoto()
For Each sh In Worksheets
    If IsNumeric(sh.Name) Then
    répertoirePhoto = "d:\Photo\" ' Adapter
nom = ActiveSheet.Name
  ActiveSheet.Pictures.Insert(répertoirePhoto & nom & ".jpg").Name = nom
  ActiveSheet.Shapes(nom).Left = [B1].Left
  ActiveSheet.Shapes(nom).Top = [B1].Top
  End If
  Next
End Sub

Impécable mille merci.

Quoi que seulement un petit détail peut on redimensionner les photos automatiquement aussi

Re,

Voila dans le code suivant tu testes et tu changes les valeurs 36.38 et 207.75 selon les dimensions desirées (l'unité ici est le point) :

Sub InsertPhoto()
For Each sh In Worksheets
    If IsNumeric(sh.Name) Then
        répertoirePhoto = "d:\Photo\"
        nom = ActiveSheet.Name
        Set c = Range("B1")
        c.ColumnWidth = 36.38 'à changer selon le besoin (en points)
        c.RowHeight = 207.75 'à changer selon le besoin
        ActiveSheet.Pictures.insert(répertoirePhoto & nom & ".jpg").Name = mm
        ActiveSheet.Shapes(mm).Left = c.Left
        ActiveSheet.Shapes(mm).Top = c.Top
        ActiveSheet.Shapes(mm).LockAspectRatio = msoFalse
        ActiveSheet.Shapes(mm).Height = c.Height
        ActiveSheet.Shapes(mm).Width = c.Width
    End If
Next
End Sub

merci je modifierai donc mes photos par la suite par contre pour inserer 2 photo a la fois une photo en jpg et un schema en coupe aussi j ai essayer ceci mais cela marche pas

Sub InsertImages()
   répertoirePhoto = "d:\Photo\" ' Adapter
   répertoireCoupe = "d:\Coupe\" ' Adapter

nom = ActiveSheet.Name
 ActiveSheet.Pictures.Insert(répertoirePhoto & nom & ".jpg").Name = nom
  ActiveSheet.Shapes(nom).Left = [B1].Left
  ActiveSheet.Shapes(nom).Top = [B1].Top

    nom1 = ActiveSheet.Name
 ActiveSheet.Pictures.Insert(répertoireCoupe & nom1 & ".jpg").Name = nom1
  ActiveSheet.Shapes(nom1).Left = [B30].Left
  ActiveSheet.Shapes(nom1).Top = [B30].Top
End Sub
 

pourquoi?