Import export d'image

Bonjour à tous

C'est la toute première fois que je pose une question sur un forum

Je suis embêter, car je réalise un document Excel pour mon apprentissage et je suis bloqué a la dernière étape, j'ai deux points à éclaircir.

Je souhaite faire un document ou les commerciaux de mon entreprise puise remplir la description du matériel, jusque-là je ne m'en suis pas trop mal sorti. Mais pour finir le document, je dois faire en sorte que les commerciaux puise déposer leurs photos sur le document excel, et que le responsable puise les télécharger sur son Pc.

- Arrive le premier hic : Actuellement ma macro sélectionne une photo en ouvrant la fenêtre parcourir et les commerciaux choisissent l'image qu'il souhaite, le problème est que ce n'est qu'un lien est que dès lors que l'on envoie le document par mail, il s'affiche un message d'erreur à la place de l'image (je souhaiterais donc que l'image soit dans le document Excel est que ce ne soit pas uniquement un lien).

- Ensuite, mon deuxième problème intervient lors de l'export de l'image déposée auparavant avec la macro précédente. La fenêtre "enregistrée sous" s'ouvre, mais l'image ne s'enregistre pas

J’espère que j'ai bien expliquer mon problème, si oui, Y a t'il quelqu'un peu m'aider s'il vous plaît ?

Merci d'avance.

PS Je mets le document en fichier joint.

Bonjour,

Je n'ouvre pas par défaut les pièces jointes quand je peux aider sans !

Tu peux utiliser un contrôle ImageList et un contrôle Image, le contrôle ImageList contient l'image (de cette façon, elle suivra le classeur) qui va être chargée dan le contrôle Image.

Pour ajouter par code (tu peux le faire manuellement à la création du contrôle ImageList) une image, voici un code, une boite s'ouvre pour choisir l'image sur le disque :

Sub ChargerImageDansListe()

    Dim Fichier As String

    Me.ImageList1.ListImages.Clear

    'ajoute l'image choisie à la liste d'image...
    With Application.FileDialog(3)

        If .Show <> -1 Then Exit Sub
        Fichier = .SelectedItems(1)

    End With

    Me.ImageList1.ListImages.Add , "Photo1", LoadPicture(Fichier)

End Sub

Là, le code pour affecter l'image au contrôle Image :

Sub InstallerImage()

    'installe l'image dans le contrôle...
    Image1.Picture = ImageList1.ListImages(1).Picture

End Sub

et ici, le code pour exporter l'image (l'enregistrer sur le disque) :

Sub Exporter()

    Dim Chemin As String
    Dim NomPhoto As String

    'exporte l'image contenue dans la liste d'image sur le disque...
    With Application.FileDialog(4)

        If .Show <> -1 Then Exit Sub
        Chemin = .SelectedItems(1)
        If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"

    End With

    NomPhoto = "Photo.jpg"

    SavePicture ImageList1.ListImages(1).Picture, Chemin & NomPhoto

End Sub

Bonjour merci pour votre implication

Voici mes deux macro, vue que vous ne pouvez pas ouvrir la pièce jointe

Les macro que vous me proposez ne peuvent aller chercher qu'une photo ? elle n'ouvre pas la fenêtre parcourir ?

Sub INSERTION_PHOTO_MATERIEL_1()

'DEPROTECTION

ActiveSheet.Unprotect ""

'SUPPRIMER LA DERNIERE PHOTO CREE

If Range("BE6") <> "" Then

PHOTO1 = Range("BE6").Value

ActiveSheet.Shapes(PHOTO1).Delete

End If

'SELECTIONER LES CELLULES FUSIONNEES

Range("BF6:CB16").Select 'emplacement des cellules fusionnées ou la photo sera affiché

Ad = Selection.Address

CellH = Selection.Height

CellW = Selection.Width

'EXTRACTION DE L'IMAGE

On Error Resume Next

Application.ScreenUpdating = False

IMPORTATION = Application.GetOpenFilename("Toutes les images (*.jpg;*.bmp;*.tiff;*.tif;*.gif;*.jpeg;*.png;*.jpe;*.jfif),*.jpg;*.bmp;*.tif;*.tiff;*.gif;*.jpeg;*.png;*.jpe;*.jfif", , "Choisissez l'image") ' choix nom du fichier

If IMPORTATION = "Faux" Then

MsgBox "Operation annulée" & vbCrLf & "Attention, veuillez renouveler l'action !", vbExclamation

'SUPRESSION DU NOM DE L'IMAGE PRECEDENTE

Range("BE6").Select

Selection.ClearContents

'SELECTIONER UNE CELLULE

[BF17].Select

'PROTECTION

ActiveSheet.Protect "lesage"

Exit Sub

End If

ActiveSheet.Pictures.Insert(IMPORTATION).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

'ENREGISTRER LE NOM DE L'IMAGE DANS LA CELLULE A GAUCHE

PHOTO2 = Selection.ShapeRange.Name

Range("BE6").Value = PHOTO2

'SELECTIONER UNE CELLULE

[BF17].Select

'PROTECTION

'ActiveSheet.Protect ""

End Sub

Sub g()

Nom = ActiveWorkbook.ActiveSheet.Name & Range("O12").Value & Range("X6").Value

'DEPROTECTION

ActiveSheet.Unprotect ""

If Range("BE6") <> "" Then

PHOTO = Range("BE6").Value

ActiveSheet.Shapes(PHOTO).Select

Else

MsgBox "Opération impossible." & vbCrLf & "Aucune image trouvée." & vbCrLf & "Si vous pensez que l'opération aurai du aboutir, envoyer moi un mail via la page d'accueil.", vbExclamation

ActiveSheet.Protect "lesage"

Range("BE6").Select

Exit Sub

End If

Export = Application.GetSaveAsFilename(Nom)

If Export = "Faux" Then '"Faux"

MsgBox "Operation annulée" & vbCrLf & "Attention, veuillez renouveler l'action !", vbExclamation

Else

Activeshats.Export ("C:\Users\Flavien\OneDrive\FLC Lesage\1 Compte rendue des reunions\4 Reunion - Modification de document\1 Modification des documents\2 Fiche expertise")

End If

End Sub

J'ai trouvé comment faire, juste désormais le nom de la photo est image xx, alors que lorsque je demande par macro de noté le nom de l'image dans la casse il me dit picture xx

'SELECTIONER LES CELLULES FUSIONNEES
    Range("BF6:CB16").Select 'emplacement des cellules fusionnées ou la photo sera affiché
            With Selection
                Picture_W = .Width
                Picture_H = .Height
                Picture_L = .Left
                Picture_T = .Top
            End With

'EXTRACTION DE L'IMAGE
    IMPORTATION = Application.GetOpenFilename("Toutes les images (*.jpg;*.bmp;*.tiff;*.tif;*.gif;*.jpeg;*.png;*.jpe;*.jfif),*.jpg;*.bmp;*.tif;*.tiff;*.gif;*.jpeg;*.png;*.jpe;*.jfif", , "Choisissez l'image") ' choix nom du fichier
        If IMPORTATION = "Faux" Then
            MsgBox "Operation annulée" & vbCrLf & "Attention, veuillez renouveler l'action !", vbExclamation
            'SUPRESSION DU NOM DE L'IMAGE PRECEDENTE
                Range("BE6").Select
                Selection.ClearContents
            'SELECTIONER UNE CELLULE
                [BF17].Select
            'PROTECTION
                ActiveSheet.Protect ""
        Exit Sub
        End If

'ENREGISTREMENT DE L'IMAGE DANS LE DOCUMENT
        Set pict = LoadPicture(IMPORTATION)
        Set IMG = ActiveSheet.Shapes.AddPicture(IMPORTATION, False, True, Picture_L, Picture_T, Picture_W, Picture_H) 'on l'insere une deuxieme fois pour l'enregistrer dans le document
         IMG.Select
        'PHOTO2 = IMG.Name

'ENREGISTRER LE NOM DE L'IMAGE DANS LA CELLULE A GAUCHE
        PHOTO2 = Selection.ShapeRange.Name
        Range("BE6").Value = PHOTO2
Rechercher des sujets similaires à "import export image"