Importer ou télécharger image en VBA

Version imprimable

20/12/2015, 15h34
Flavien41100

Importer ou télécharger image en VBA

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.
20/12/2015, 16h20
kiki29

Salut, cela devrait t'aider : Utiliser la librairie Windows Image Acquisition en VBA
20/12/2015, 17h47
Flavien41100

Merci pour ta réponse mais Je ne comprend pas il parle pas de sauvegarder l'image dans le document excel ?
Comment faire pour que l'image reste disponible dans excel même si elle a était supprimé sur le PC ou alors que le document excel a était envoyer par mail ?
Connait tu la macro nécessaire ?
20/12/2015, 18h06
Invité

Bonsoir,
Si j'ai bien compris, dans ton fichier Excel tu as le lien d'une image située sur le site web de l,entreprise.

Le site Web est visible en dehors de l'entreprise ou uniquement en intranet?

Si ton site est visible hors de l'entreprise, tu peux envoyer ton mail au format html.

Dans ce cas pas besoin de télécharger l'image, seule le lien tel que dans ta cellule Excel est suffisant.

Regarde bodyhtml de ta méthode d'envois de mail.
20/12/2015, 18h37
Flavien41100

Bonjour, merci pour votre implication
En faite l'image ce situe sur le disque dure du PC de l'un des commerciaux, ensuite il envoie le fichier au responsable pour qu'il estime le prix
Ma macro charge l'image correctement, le problème est que ce n'est qu'un lien, une fois le document excel est envoyer il n'y a plus d'image sur le doc excel
vous avez compris l'idée ?
20/12/2015, 18h48
SfJ5Rpw8

Bonjour,

montre nous le morceau de code ( entre balises ) qui effectue l'insertion de ton image dans le fichier excel.

Bonjour voici le code, l'insertion en elle même se réalise au caractère en gras

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
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
 
'-----        [ B]
ActiveSheet.Pictures.Insert(IMPORTATION).Select
'-------------[ /B] ' 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