Discussion :

[Lionel-FW]

Bonjour a tous,

Apres avoir fait plusieurs essais, j'ai réussi a créer un bouton pour insérer une image via un bouton dans une zone ciblée (plusieurs cellules fusionnées), en passant par Pictures.Insert mais lorsque que je veux l'ouvrir sur le poste d'un collègue, les images ne sont plus présentes a cause du lien que cette fonction crée.

J'ai vu qu'il fallait maintenant passer par la fonction AddPictures, mais je ne sais pas si cela fonctionne avec un bouton.. De ce que j'en vois, non car l'image n'apparait dans le fichier.

Le but de ce classeur est qu'il soit commun a tous nos technicien, je ne veux pas passer par un chemin d'accès aux photos car ces chemins seront clairement tous différents a chaque technicien.

Je vous mets ci dessous le code avec le pictures.insert, je ne sais pas si cela est adaptable..

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub insere_image()
 
    Dim ficimg As String, Ad As String
 
        Ad = Selection.Address
        ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image") ' choix nom du fichier
        If ficimg = "Faux" Then Exit Sub
 
        ActiveSheet.Pictures.Insert(ficimg).Select ' insertion
            With Selection.ShapeRange
                .LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez 'Pas besoin, c'est fait automatiquement sur la sélection ''''
                .Top = Range(Ad).Top ' haut de la cellule '''''
                .Left = Range(Ad).Left ' gauche de la cellule
                .Height = Range(Ad).Height ' hauteur des cellules fusionnées
                .Width = Range(Ad).Width ' largeur des cellules fusionnées
 
            End With
 
            With Selection
                .Placement = xlMoveAndSize
                .PrintObject = True
            End With
 
End Sub

Merci pour votre aide.
Cordialement,

[Invité]

Bonjour,

Quel est le problème avec ce code ? Les images sont toujours présentes une fois importées.

[Lionel-FW]

Bonjour,

Ce code fonctionne bien. La problématique est la suivante:
- Je mets a disposition plusieurs documents vierges pour des rapports d'essais chez nos clients
- Nos techniciens les remplissent et y ajoute leurs photos
- Ils nous renvoient les documents complétés mes les photos ne suivent pas.


Nous devons renvoyer les rapports d'essais au client afin qu'il voit l'efficacité de nos machine, et de savoir s'ils en achètent une ou non.

Je souhaiterai avoir les photos sauvegardées dans le document, mais pouvoir l'insérer via un bouton.

Cordialement,

[Invité]

Chez moi, les photos restent associées au fichier, je n'ai pas de liaison.

[Lionel-FW]

Bonjour Eric,

Même si vous déplacer le fichier ou renommer la photo importée ?

Cordialement,

[Invité]

Effectivement le lien disparaît.

Regardez si ce code règle votre problème :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
 
Sub TesterLInsertImage2()
 
Dim FicImg As Variant
Dim Ad As String
 
        Ad = Selection.Address
        FicImg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image")
        If FicImg = "Faux" Then Exit Sub
 
        Insert_Image2 Range(Ad), FicImg
 
End Sub
 
 
Sub Insert_Image2(ByVal CelluleImage As Range, ByVal CheminImage As String)
 
Dim ShImage As Worksheet
 
Dim ImageLargeur As Single, RatioImage As Single
Dim MonImage As Shape
Dim NbShapes As Integer
 
    Set ShImage = CelluleImage.Parent
 
    With ShImage
 
        ImageLargeur = CelluleImage.Width
        RatioImage = ImageRatio(CheminImage)
 
        NbShapes = .Shapes.Count + 1
 
         ' Insertion de l'image
         '---------------------
         Set MonImage = .Shapes.AddShape(msoShapeRectangle, CelluleImage.Left, CelluleImage.Top, ImageLargeur, ImageLargeur / RatioImage)
         With MonImage
              .Name = "ImageFeuille" & NbShapes
              With .Fill
                   .Visible = msoTrue
                   .UserPicture CheminImage
              End With
              With .Line
                   .Visible = msoTrue
                   .Weight = 1
              End With
         End With
         Set MonImage = Nothing
 
    End With
 
      Set ShImage = Nothing
 
 End Sub
 
 
Function ImageRatio(ByVal CheminEtNomDeLImage As String) As Single
 
' A partir du tuto "Utiliser la librairie Windows Image Acquisition en VBA" de SilkyRoad et Bbil
 
Dim Img As Object
 
    Set Img = CreateObject("WIA.ImageFile")
    With Img
         .LoadFile CheminEtNomDeLImage
         ImageRatio = .Width / .Height
    End With
    Set Img = Nothing
 
End Function