Copier une photo dans une cellule

Bonjour,

j'aimerais compléter un tableau à partir d'un Userform, dans lequel doit être insérer une image ainsi des qu'on tape le nom et le prénom cela crée un identifiant correspondant à une image dans l'onglet photo des que la personne à choisie si elle voulait ou non copier l'image cela l’insère au dimension de la case dans la colonne 3 or si la ligne et agrandi l'image doit s'agrandir elle aussi

sachant que je ne suis pas sur d'avoir été très clair voici mon fichier

merci

Coucou,

Essaie de remplacer le code de ton Userform (USF) par celui-ci :

Private Sub CommandButton1_Click()
Unload Me
 Dim X As Integer
 Dim ficimg As String, Ad
    Dim MemW As Long, MemH As Long, T As Integer, L As Integer
    Dim Lg As Integer, HT As Integer, RatioCell As Single
    Dim CellH As Long, CellW As Long, RatioHz As Single, RatioVt As Single
   X = ActiveSheet.Range("a65536").End(xlUp).Row + 1
ActiveSheet.Range("A" & X).Value = Me.TextBox1 'Nom
ActiveSheet.Range("B" & X).Value = Me.TextBox2 'prenom
ActiveSheet.Range("C" & X).Value = Me.TextBox1 & Me.TextBox2
ActiveSheet.Range("D" & X).Select
        Ad = Selection.Address
        CellH = Selection.Height
        CellW = Selection.Width
        ficimg = Application.GetOpenFilename(".jpg,*.jpg,.gif,*.gif,.jpeg,*.jpeg", , "Choisissez l'image") ' choix nom du fichier
     If ficimg = "Faux" Then Exit Sub
        ActiveSheet.Pictures.Insert(ficimg).Select ' insertion

      With Selection.ShapeRange
            MemW = .Width: MemH = .Height
            'adapte les ratio
         If MemH < CellH And MemW < CellW Then
            'l'image < cellule
             RatioHz = MemH / CellH
                RatioVt = MemW / CellW
                If RatioVt < RatioHz Then 'adapter en hauteur
                 HT = CellH:  Lg = MemW * (HT / MemH)
                    T = 0: L = (CellW - Lg) / 2
                Else 'adapter en largeur
                 Lg = CellW: HT = MemH * (CellW / MemW)
                    L = 0: T = (CellH - HT) / 2
                End If
            ElseIf MemH > CellH And MemW > CellW Then
            'l'image > cellule
             RatioHz = CellH / MemH
                RatioVt = CellW / MemW
                If RatioVt > RatioHz Then 'adapter en hauteur
                 HT = CellH:  Lg = MemW * (HT / MemH)
                    T = 0: L = (CellW - Lg) / 2
                Else 'adapter en largeur
                 Lg = CellW: HT = MemH * (Lg / MemW)
                    L = 0: T = (CellH - HT) / 2
                End If
            ElseIf MemH > CellH And MemW < CellW Then
            'adapter en hauteur
             HT = CellH:  Lg = MemW * (HT / MemH)
                T = 0: L = (CellW - Lg) / 2
            ElseIf MemH < CellH And MemW > CellW Then
            'adapter en largeur
             Lg = CellW: HT = MemH * (Lg / MemW)
                L = 0: T = (CellH - HT) / 2
            Else
                Stop ' pas prévu ?
         End If

            .LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
         .Top = Range(Ad).Top + T ' haut de la cellule
         .Left = Range(Ad).Left + L ' gauche de la cellule
         .Height = HT
            .Width = Lg ' largeur des cellules fusionnées
     End With
        With Selection
            .Placement = xlMoveAndSize
            .PrintObject = True
        End With
    End Sub

Private Sub TextBox1_Change()
TextBox3 = TextBox1 & " " & TextBox2
End Sub

Private Sub TextBox2_Change()

TextBox3 = TextBox1 & " " & TextBox2
End Sub

Chez moi ça marche )

le problème avec ce code c'est que ça fait appel au image qui son sur mon ordinateur or les photos sont déjà présente dans mon classeur est ce qu'il y aurait un moyen d'identifier les photos pour permettre de les appeler si l'identifiant et similaire au nom des photos ou quelque chose comme ça??

merci

Le problème c'est que l'identifiant est variable, donc difficile de se baser sur le "nom" de la photo.

Peut-être en les sélectionnant, je te tiens au jus

Ok, merci