Ajouté une photo

Salut tout le monde

J’ai un problème et j’ai besoin de vous connaissance on code vba

Voilà j’ai un classeur qui contient des feuilles

Sur la feuille « Gestion » j’ai besoin de glissé une photo qui se trouve sur mon pc après avoir actionné le Botton « Ajouté une photo ».

Quand je clic sur le Botton j’aimerai qu’une fenêtre s’ouvre et me donne la possibilité de chercher la photo sur mon pc.

Merci à vous

Salut,

Exemple :

Private Sub CommandButton1_Click()
Dim stfile As String
stfile = Application.GetOpenFilename

MsgBox stfile  'Affiche le fichier sélectionné

End Sub

Damien

Salut Bigdams

Pour la première action si bon mais je veux qu’après avoir sélectionné la photo qu’elle s’affiche sur le rectangle « Image1 »

merci

Bonjour à Tous,

je n'ai pas ouvert ton fichier mais j'ai un code qui en sélectionnant une case de ton classeur, après action sur un bouton macro, insére une image aux dimensions de la cellule.

Sub insere_image()

Dim ficimg As String, Ad As String
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
    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

A tester

Salut Niko

Merci mais ça me conviens pas mais malgré sa merci

Salut,

Essais ce code et dis nous.

Private Sub CommandButton1_Click()
Dim stfile As String
stfile = Application.GetOpenFilename
Me.Image1.PictureSizeMode = fmPictureSizeModeStretch
Me.Image1.Picture = LoadPicture(stfile)
End Sub

Damien

J'avais pas vu le fichier .... La loose

cf fichier attaché :

Salut

A voir si ca te va , sur le fichier que je t'envoie .

je peut pas faire plus cet une macro qu'on ma faite sur ce forum

Cordialement

Bonjour

Merci pour tout le monde ça marche très bien a plus