Insertion auto d'une photo ou logo

Bonjour à tous

J'aimerai creer un formulaire comprenant différente données et l'utilisateur pourrais ajouter ça photo mais à un endroit et avec un phorma prédéfini.

Voici ce que j'ai sous la main mais ça ne fonctionne pas... quelqu'un à une idée?

Merci d'avance

Sub afficher_photo()
Dim DosPhoto As FileDialog
With Feuille6
Set DosPhoto = Application.FileDialog(msoFileDialogFolderPicker)
With DosPhoto
   .Title = "séléctionner une photo"
   .Filters.Add "A11 picture Files", "*.jpg,*jpeg,*gif,*png,*bmp,*.tiff", 1
   If .Show <> -1 Then GoTo NoSelection
   Feuille6.Range("M10").Value = .SelectedItems(1)
   End With
NoSelection:
   End With
   End Sub

Dim LienPhoto As String
With Feuille6
On Error Resume Next
.Shapes("Photo_existante").Delete
On Error GoTo 0
LienPhoto = .Range("M10").Value
With .Pictures.Insert(LienPhoto)

  With .ShapeRange
       .LockAspectRatio = msoTrue
       .Height = 140
       .Name = "Photo_existante"
   End With
End Sub

With .Shapes("Photo_existante")
     .Left = Feuille6.Range("K8").Left
     .Top = Feuille6.Range("K8").Top
     .IncrementLeft 30

 End With
 End With

End Sub

bonsoir,

proposition de correction de ton code

Sub afficher_photo()
    Dim DosPhoto As FileDialog

    Set DosPhoto = Application.FileDialog(msoFileDialogFilePicker)
    With DosPhoto
        .Title = "séléctionner une photo"
        .Filters.Add "A11 picture Files", "*.jpg,*jpeg,*gif,*png,*bmp,*.tiff", 1
        If .Show = -1 Then Feuille6.Range("M10").Value = .SelectedItems(1) Else Exit Sub
    End With

    Dim LienPhoto As String
    With Feuille6
        On Error Resume Next
        .Shapes("Photo_existante").Delete
        On Error GoTo 0
        LienPhoto = .Range("M10").Value
        With .Pictures.Insert(LienPhoto)
            With .ShapeRange
                .LockAspectRatio = msoTrue
                .Height = 140
                .Name = "Photo_existante"
                .Left = Feuille6.Range("K8").Left
                .Top = Feuille6.Range("K8").Top
                .IncrementLeft 30
            End With
        End With
    End With

End Sub

Bonsoir et merci beaucoup pour ton aide.

Effectivement ça va un peu mieux

Voici le retour