Sub Nommer_une_Image()
Dim NouveauNom As String
On Error GoTo Erreur_Msg
MsgBox Selection.Name
NouveauNom = InputBox("Attribuer un nouveau nom à l'image")
Selection.Name = NouveauNom
Exit Sub
Erreur_Msg:
MsgBox "Pas de formes sélectionnées" & Chr(13) _
& "Veuillez sélectionner une image, svp", , "Erreur : "
End Sub'... c'est dans cette partie du code, qu'il faudra modifier
Select Case myCell.Value
Case "L": pictName = "rainure_languette"
'c'est ici qu'on adpate les noms des images
Case "M": pictName = "mortaise"
Case "T": pictName = "tenon"
Case "rien": pictName = "bois_droit"
End Select
'...Private Sub Worksheet_Change(ByVal Target As Range)
Dim pictName As String
Dim pictLoc As Range
Dim myCell As Range
Dim myPicture As Picture
Dim myNewPicture As Picture
Set myCell = ActiveCell
Set pictLoc = Target.Offset(0, 2)
If Target.Column = 4 And Target.Row > 5 Then MsgBox pictLoc.Address
Application.ScreenUpdating = False
pictName = ""
Select Case myCell.Value
Case "L": pictName = "rainure_languette"
Case "M": pictName = "mortaise"
Case "T": pictName = "tenon"
Case "R": pictName = "bois_droit"
End Select
If pictName <> "" Then
For Each myPicture In Me.Pictures
If myPicture.TopLeftCell <> pictLoc(1) Then
Exit For
End If
Next myPicture
Worksheets("images").Pictures(pictName).Copy
Me.Paste
Set myNewPicture = Me.Pictures(Me.Pictures.Count)
With pictLoc
myNewPicture.Top = .Top
myNewPicture.Height = .Height
myNewPicture.Width = .Width
myNewPicture.Left = .Left
End With
Target.Select
End If
End Sub
