Insérer une image VBA - WORDRésolu

Question

Bonjour,

J'aimerais pouvoir insérer une image dans mon document Word.
j'ai créé un bouton "PARCOURIR" avec ce code :
Private Sub ButtonPARCOURIR_Click()

    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        .Show
        GENERALITE.TextBoxParcourir.Text = .SelectedItems(1)'inscrit le chmin dans un TextBox
    End With

End Sub

Mais comment faire pour ensuite copier l'image sélectionnée ??! Je cherche depuis environ 2 ou 3 heures sur google mais je n'arrive pas à m'en sortir 

Si vous savez également comment mettre un aperçu sur la UserForm avec l'outil Image, je suis preneuse

cs_Le Pivert · Accepted Answer

Voici pour la 2ème question

Private Sub CommandButton2_Click()
Image1.PictureSizeMode = fmPictureSizeModeZoom'tu peux modifier
Image1.Picture = LoadPicture("Chemin du fichier.jpg")
End Sub



@+Le Pivert

cs_Le Pivert · Answer

Bonjour,

Voici le code:
Private Sub CommandButton1_Click()
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        .Show
        TextBox1.Text = .SelectedItems(1) 'inscrit le chmin dans un TextBox
    End With
  Selection.InlineShapes.AddPicture FileName:=TextBox1.Text, LinkToFile:=False, SaveWithDocument:=True
End Sub

j'ai pris pour plus de commodité
CommandButton1 et  TextBox1 à adapter suivant tes besoins.
Un petit conseil pour la prochaine fois. Utilise l'enregistreur de macro et fait ta manip et tu auras ton code tout prêt. Il ne te restera qu'a l'adapter.
@+ Le Pivert 



Le Pivert

spie31 · Answer

Merci pour ces réponses !!
pour la première, effectivement en enregistrant une macro, et en essayant de bidouiller, j'avais réussi :)
pour la 2ème je pataugeait !!

J'ai voulu, à la suite de ça redimensionner l'image. J'ai enregistré une macro mais seulement, ça donne la hauteur et largeur voulu (pour une autre image, forcement ça la déforme.

J'ai essayé ce code :


Sub redimensionnerImage()
    Dim Img As WIA.ImageFile, IP As WIA.ImageProcess
    
    'Création conteneur pour l'image à manipuler
    Set Img = CreateObject("WIA.ImageFile")
    'Création du gestionnaire de filtre
    Set IP = CreateObject("WIA.ImageProcess")
    
    'Chargement de l'image dans le conteneur
    Img.LoadFile "C:\fourmiz.JPG"
    
    	'Ajoute le filtre pour redimensionner l'image (Scale)
        IP.Filters.Add IP.FilterInfos("Scale").FilterID
        'Définit la largeur maxi pour le redimensionnement
        IP.Filters(1).Properties("MaximumWidth") = 90
        'Définit la hauteur maxi pour le redimensionnement
        IP.Filters(1).Properties("MaximumHeight") = 90
        'remarque :
        'Les proportions sont conservées. Le filtre prend en compte
        'les ratios et adapte la taille pour ne pas dépasser les valeurs maxi définies.
        
    'Application du filtre à l'image
    Set Img = IP.Apply(Img)
    'Enregistre l'image redimensionnée
    Img.SaveFile "C:\fourmizThumbnail.JPG"
End Sub


mais ca ne marche pas, ça bug dès la première ligne. Avez-vous une idée ?

cs_Le Pivert · Answer

Tu as trouvé ce code sur ce site, qui t'informe qu'il  utilise la DLL: WIAAUT.DLL. Sans cette DLL cela ne peut fonctionner.

http://silkyroad.developpez.com/VBA/WindowsImageAcquisition/

Donc pour utiliser cette DLL télécharge ce programme en VB.Net et VBA EXCEL (cela fonctionne pour Word)
http://www.vbfrance.com/codes/REDIMENSIONNER-IMAGE_50214.aspx

Tu ouvres le classeur Excel
Tout est expliqué pour enregistrer cette DLL  dans ce programme
Bon courage

spie31 · Answer

c'est bien compliqué ce vba !!!  

seulement ce programme va être utilisé par plusieurs ordinateurs différents ! il faudrait donc que tous les PC est ce programme de téléchargé logiquement ...

il n'y a pas une autre solution pour indiquer une hauteur ou largeur max tout en gardant le ratio (c'est pour ça qu'il faut hauteur mx et largeur max) car sinon ça ne me garde pas le ratio (j'ai fait pas mal d'essai (lockedratio = True, ou quelque chose comme ça !)

cs_Le Pivert · Answer

Si tes images sont toutes en mode paysage, tu dimensionnes ton outil Image en un rectangle qui approche le plus possible de tes images. Puis ensuite tu mets ce code:

Image1.PictureSizeMode = fmPictureSizeModeStretch

C'est le plus simple. 

Par contre si il y a des images en mode portrait tu laisse ton outil Image carré avec un fond de la même couleur que ton UserForm et tu mets ce code:

Image1.PictureSizeMode = fmPictureSizeModeZoom

spie31 · Answer

Merci.

Pour l'aperçu à la limite c'est pas bien grave, en fait il me faudrait redimensionner l'image une fois copiée dans word !

spie31 · Answer

Je pensais créer une Userform avec la formule que tu m'as dit, (comme ça, ça la met à la bonne échelle) puis ensuite copier cette image dans Word, seulement on copie l'image par le chemin d'accès, et non pas directement la photo du Userform ... donc omn idée ne fonctionne pas !

cs_Le Pivert · Answer

Voilà ce que je te propose. Tout d'abord vu que cela est pour distribuer, tu ne peux pas faire la recherche de fichier image de cette manière.
Si tu ne cliques pas sur OK  dans ta boite de dialogue 1er bug et si tu sélectionnes autre chose que du fichier image 2 ème bug.
Voici le code:

Dim image As Integer
'ouvrir fichier image
Private Sub CommandButton1_Click()
'Declare a variable as a FileDialog object.
    Dim fd As FileDialog
    Dim fichier As String
    'Create a FileDialog object as a File Picker dialog.
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
'Declare a variable to contain the path
    'of each selected item. Even though the path is a String,
    'the variable must be a Variant because For Each...Next
    'routines only work with Variants and Objects.
    Dim vrtSelectedItem As Variant
'Use a With...End With block to reference the FileDialog object.
    With fd
'Add a filter that includes GIF and JPEG images and make it the first item in the list.
        .Filters.Add "Images", "*.gif; *.jpg; *.jpeg", 1

        'Use the Show method to display the File Picker dialog box and return the user's action.
        'If the user presses the action button...
        If .Show = -1 Then

            'Step through each string in the FileDialogSelectedItems collection.
            For Each vrtSelectedItem In .SelectedItems

                'vrtSelectedItem is a String that contains the path of each selected item.
                'You can use any file I/O functions that you want to work with this path.
                'This example simply displays the path in a message box.
               fichier = vrtSelectedItem
      
            Next vrtSelectedItem
        'If the user presses Cancel...
        Else
        End If
    End With

    'Set the object variable to Nothing.
    Set fd = Nothing
      If fichier = "" Then Exit Sub
      'inserer image
  Selection.InlineShapes.AddPicture FileName:=fichier, LinkToFile:=False, SaveWithDocument:=True
'aperçu image userForm
Image1.PictureSizeMode = fmPictureSizeModeZoom
Image1.Picture = LoadPicture(fichier)
'redimensionner
NbreShape
ActiveDocument.InlineShapes(image).Width = 100   'largeur
ActiveDocument.InlineShapes(image).Height = 75 'hauteur
End Sub
Private Sub NbreShape() 'nbre d'images
Set doc = ActiveDocument
image = doc.InlineShapes.Count
End Sub


Tu as les commentaires. Si tu veux changer les dimensions tu joues sur:

ActiveDocument.InlineShapes(image).Width = 100   'largeur
ActiveDocument.InlineShapes(image).Height = 75 'hauteur
Les shapes ceux sont tes images. Donc je cherche le nbre d'images avec Private Sub NbreShape() que je mets ensuite dans 

ActiveDocument.InlineShapes(image).Width = 100   'largeur
ActiveDocument.InlineShapes(image).Height = 75 'hauteur
comme cela à chaque insertion d'image c'est recalculé.
J'ai remplacé ton textBox par la variable fichier qui est plus indiqué. Mais si tu veux voir le chemin de ton fichier image priviligie un Label.Un textBox sert a faire des saisies manuelles.
Ce qu'il faut dans un programme c'est de comprendre ce qui a été fait. Sinon cela ne sert à rien.
@+Le Pivert

spie31 · Answer

pour la première erreur, j'avais inséré, au début de la fonction :
On Error Resume Next
(donc si on appuyait sur annuler, ça fonctionnait)
par contre je n'arrivais pas à définir les images comme type de fichier par défaut ! merci 

apres pour ce qui est des dimension, toujours le meme soucis : ce sera toujours des images différentes donc on ne peut pas prévoir à l'avance la largeur et hauteur désirée. L'image se déforme selon si elle est en portrait, en paysage ou carrée 
c'est pour ça qu'il faudrait en fait une largeur et hauteur Maximum et qui garde les bonnes proportions.
Possible apparemment sur excel mais pas sur Word 


en tout cas t'es super fort

ucfoutu · Answer

Bonjour,

Je ne travaille presque jamais avec Word.
Il me semble toutefois me rappeler qu'il faut dans de tels cas procéder en 2 temps : l'un pour définir les propriétés du "rectangle" d'accueil, l'autre pour y ajouter une image.
Je ne suis pas vraiment certain de ce que j'avance-là peut-être stupidement.
J'essaierais cet après-midi (pour la cas où). 


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

cs_Le Pivert · Answer

Ce code fonctionne, mais je me suis servi de la DLL WIAAUT pour récupérer les dimensions de l'image. Si tu trouves une autre solution pour récupérer ces dimensions. Tu pourras facilement l'adapter:
'ouvrir fichier image
Private Sub CommandButton1_Click()
'Declare a variable as a FileDialog object.
    Dim Img As WIA.ImageFile
    Dim fd As FileDialog
    Dim fichier As String
    Dim image As Integer
    Dim hauteur As Integer
    Dim largeur As Integer
    'Create a FileDialog object as a File Picker dialog.
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
'Declare a variable to contain the path
    'of each selected item. Even though the path is a String,
    'the variable must be a Variant because For Each...Next
    'routines only work with Variants and Objects.
    Dim vrtSelectedItem As Variant
'Use a With...End With block to reference the FileDialog object.
    With fd
'Add a filter that includes GIF and JPEG images and make it the first item in the list.
        .Filters.Add "Images", "*.gif; *.jpg; *.jpeg", 1

        'Use the Show method to display the File Picker dialog box and return the user's action.
        'If the user presses the action button...
        If .Show = -1 Then

            'Step through each string in the FileDialogSelectedItems collection.
            For Each vrtSelectedItem In .SelectedItems

                'vrtSelectedItem is a String that contains the path of each selected item.
                'You can use any file I/O functions that you want to work with this path.
                'This example simply displays the path in a message box.
               fichier = vrtSelectedItem
      
            Next vrtSelectedItem
        'If the user presses Cancel...
        Else
        End If
    End With

    'Set the object variable to Nothing.
    Set fd = Nothing
      If fichier = "" Then Exit Sub
      'inserer image
  Selection.InlineShapes.AddPicture FileName:=fichier, LinkToFile:=False, SaveWithDocument:=True
'aperçu image userForm
Image1.PictureSizeMode = fmPictureSizeModeZoom
Image1.Picture = LoadPicture(fichier)
'redimensionner
Set Img = CreateObject("WIA.ImageFile")
Img.LoadFile fichier  ' chemin du fichier source
largeur = Img.Width 'largeur de l'image
hauteur = Img.Height 'hauteur de l'image
If largeur > hauteur Then
image = ActiveDocument.InlineShapes.Count 'nbre d'images
ActiveDocument.InlineShapes(image).Width = 100   'largeur
ActiveDocument.InlineShapes(image).Height = 75 'hauteur
Else
image = ActiveDocument.InlineShapes.Count 'nbre d'images
ActiveDocument.InlineShapes(image).Width = 75 'largeur
ActiveDocument.InlineShapes(image).Height = 100 'hauteur
End If
End Sub


 

@+Le Pivert

ucfoutu · Answer

Bonjour, Le Pivert
Il est en effet possible d'éviter WIA.
Ainsi, par exemple :
Un contrôle Image nommé Image1 sur un Userform nommé UserForm1 et dont les propriétés (de Image1) sont Autosize = True
En y chargeant l'image (sans même montrer UserForm1) ==>>
 UserForm1.Image1.Picture = LoadPicture(chemin_de_l'image)
Userform1.image1.height et userform1.image1.width retourneront les dimensions exactes de l'image originelle.
____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

spie31 · Answer

J'ai essayé cette méthode. Seulement après, sur mon document Word, je ne peux pas coller directement l'image, on ne peut copier que par le chemin. Donc dans l'aperçu de la UserForm ce sera bien mais quand ça collera dans le Word, ce sera la photo de "base"

Mais tant pis, vous tracassez pas ! on effectuera la modif à la main (ou plutot à la souris  ) une fois le programme terminer

ucfoutu · Answer

Mais pas du tpout, spie31 !
Qui te parle d' "aperçu" ? le userform n'est même pas montré ! il ne sert qu'à "relever" les dimensions réelles.
A partir de ces dimensions ==)=>> un simple calcul arithmétique te permettre, sur une image "stretchée" sur ton document, d'en définir les dimensions souhaitables !
Un petit truc : partir d'un carré dont les côtés sont la dimension maximum que tu veux ===>>  prendre, des deux dimensions réelles trouvées, la plus petite ===>> donner à l'autre la valeur du côté et à celle-là (la plus petite) la valeur du côté * k où k est le ra^pport de la plus petite sur la plus grande.
Exemple :
je "prévois" un carré de 50 x 50
soit L = 100 la largeur réelle de l'image (sur le userform)
soit H = 70 la hauteur réelle de l'image (sur le userform)

sur mon document- ===>> mon image en mode "stretché" devra avoir 50 de largeur et 50 * (70/100) de hauteur  pour ne pas être déformée
Ce n'est que de l'arithmétique !



____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

cs_Le Pivert · Answer

Un grand merci à UCFOUTU
Voici le code:

'ouvrir fichier image
Private Sub CommandButton1_Click()
'Declare a variable as a FileDialog object.
    Dim fd As FileDialog
    Dim fichier As String
    Dim image As Integer
    Dim hauteur As Integer
    Dim largeur As Integer
    'Create a FileDialog object as a File Picker dialog.
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
'Declare a variable to contain the path
    'of each selected item. Even though the path is a String,
    'the variable must be a Variant because For Each...Next
    'routines only work with Variants and Objects.
    Dim vrtSelectedItem As Variant
'Use a With...End With block to reference the FileDialog object.
    With fd
'Add a filter that includes GIF and JPEG images and make it the first item in the list.
        .Filters.Add "Images", "*.gif; *.jpg; *.jpeg", 1

        'Use the Show method to display the File Picker dialog box and return the user's action.
        'If the user presses the action button...
        If .Show = -1 Then

            'Step through each string in the FileDialogSelectedItems collection.
            For Each vrtSelectedItem In .SelectedItems

                'vrtSelectedItem is a String that contains the path of each selected item.
                'You can use any file I/O functions that you want to work with this path.
                'This example simply displays the path in a message box.
               fichier = vrtSelectedItem
      
            Next vrtSelectedItem
        'If the user presses Cancel...
        Else
        End If
    End With

    'Set the object variable to Nothing.
    Set fd = Nothing
      If fichier = "" Then Exit Sub
      'inserer image
  Selection.InlineShapes.AddPicture FileName:=fichier, LinkToFile:=False, SaveWithDocument:=True
'aperçu image userForm
Image1.PictureSizeMode = fmPictureSizeModeZoom
Image1.Picture = LoadPicture(fichier)
'redimensionner
Image1.AutoSize = True
largeur = UserForm1.Image1.Width   'largeur de l'image
hauteur = UserForm1.Image1.Height 'hauteur de l'image
If largeur > hauteur Then
image = ActiveDocument.InlineShapes.Count 'nbre d'images
ActiveDocument.InlineShapes(image).Width = 100   'largeur
ActiveDocument.InlineShapes(image).Height = 75 'hauteur
Else
image = ActiveDocument.InlineShapes.Count 'nbre d'images
ActiveDocument.InlineShapes(image).Width = 75 'largeur
ActiveDocument.InlineShapes(image).Height = 100 'hauteur
End If
Image1.Width = 60 'a modifier
Image1.Height = 60 'a modifier
End Sub




Le Pivert

cs_Le Pivert · Answer

J'ai trouvé comment redimensionner avec:
LockAspectRatio
Donc voici le code. J'ai ajouté pendant que j'y étais le redimensionnement de l'aperçu image, la suppression de la dernière image et la suppression de toutes les images.

 Option Explicit
  Dim image, hauteur, largeur As Integer
   'ouvrir fichier image
Private Sub CommandButton1_Click()
Dim objDoc As Document, objShape As InlineShape
'Declare a variable as a FileDialog object.
    Dim fd As FileDialog
    Dim Fichier As String
   'Create a FileDialog object as a File Picker dialog.
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
'Declare a variable to contain the path
    'of each selected item. Even though the path is a String,
    'the variable must be a Variant because For Each...Next
    'routines only work with Variants and Objects.
    Dim vrtSelectedItem As Variant
'Use a With...End With block to reference the FileDialog object.
    With fd
'Add a filter that includes GIF and JPEG images and make it the first item in the list.
        .Filters.Add "Images", "*.gif; *.jpg; *.jpeg", 1

        'Use the Show method to display the File Picker dialog box and return the user's action.
        'If the user presses the action button...
        If .Show = -1 Then

            'Step through each string in the FileDialogSelectedItems collection.
            For Each vrtSelectedItem In .SelectedItems

                'vrtSelectedItem is a String that contains the path of each selected item.
                'You can use any file I/O functions that you want to work with this path.
                'This example simply displays the path in a message box.
               Fichier = vrtSelectedItem
      
            Next vrtSelectedItem
        'If the user presses Cancel...
        Else
        End If
    End With

    'Set the object variable to Nothing.
    Set fd = Nothing
      If Fichier = "" Then Exit Sub
  
      'inserer image et redimensionner à modifier si necessaire
Set objShape = Selection.InlineShapes.AddPicture(FileName:=Fichier, LinkToFile:=False, SaveWithDocument:=True)
With objShape
    .LockAspectRatio = msoTrue
    .Height = .Height * 0.25 'réduit l'image
    .Width = .Width * 0.25 'réduit  l'image
End With
 'charger image userForm
Image1.Picture = LoadPicture(Fichier)

'aperçu image userForm
Image1.AutoSize = True
largeur = UserForm1.Image1.Width   'largeur de l'image
hauteur = UserForm1.Image1.Height 'hauteur de l'image

If largeur > hauteur Then 'mode paysage
With Image1
.BackColor = &H8000000F
.PictureSizeMode = fmPictureSizeModeZoom
.Width = 100 'a modifier
.Height = 70 'a modifier
End With

ElseIf largeur = hauteur Then 'mode carré
With Image1
.BackColor = &H8000000F 'couleur de l'UserForm(blanche)à modifier si necessaire
.PictureSizeMode = fmPictureSizeModeZoom
.Width = 100 'a modifier
.Height = 100 'a modifier
End With

Else 'mode portrait
With Image1
.BackColor = &H8000000F
.PictureSizeMode = fmPictureSizeModeZoom
.Width = 85 'a modifier
.Height = 100 'a modifier
End With
End If
End Sub
'suppression de la dernière image
Private Sub CommandButton2_Click()
image = ActiveDocument.InlineShapes.Count 'nbre d'images
 ActiveDocument.InlineShapes(image).Delete 'supprime la dernière image
End Sub
'suppression de toutes les images
Private Sub CommandButton3_Click()
  Dim intResponse As Integer
     intResponse = MsgBox("Etes-vous sûr de vouloir " & _
        "supprimer toutes les images?", vbYesNo)
If intResponse = vbYes Then
        ActiveDocument.Content.Select
        Selection.Delete
    End If
End Sub
Private Sub UserForm_Initialize()
Me.Caption = "Inserer image"
With CommandButton1
.Caption = "Rechercher image"
.AutoSize = True
End With
With CommandButton2
.Caption = "Supprimer dernière image"
.AutoSize = True
End With
With CommandButton3
.Caption = "Supprimer toutes les images"
.AutoSize = True
End With
End Sub


Si cela t'interesse j'ai aussi l'ouverture de l'UserForm à partir du MenuBar

@+Le Pivert

spie31 · Answer

Désolé pour le retard !
J'etais en (mini) vacances !

Alors j'ai essayé ton code, (le premier, pas le dernier) cela à fonctionné pour une image, et pour l'autre, la première fois que j'ai sélectionné elle n'a pas été redimensionnée et lorsque j'ai resélectionné, (donc 2ème insertion dans Word, et à la suite de la première (identique)) elle a été redimensionnée.

Par contre, ils ne peuvent sélectionner qu'une seule photo (ils appuyent sur parcourir, choisissent la photo, il y a ensuite un mini aperçu et quand ils cliquent sur OK, la photo s'intègre dans le document.

Ton code, permet de sélectionner plusieurs photos, et cette partie là et donc "inutile" non ? : 
'suppression de la dernière image
Private Sub CommandButton2_Click()
image = ActiveDocument.InlineShapes.Count 'nbre d'images
 ActiveDocument.InlineShapes(image).Delete 'supprime la dernière image
End Sub
'suppression de toutes les images
Private Sub CommandButton3_Click()
  Dim intResponse As Integer
     intResponse = MsgBox("Etes-vous sûr de vouloir " & _
        "supprimer toutes les images?", vbYesNo)
If intResponse = vbYes Then
        ActiveDocument.Content.Select
        Selection.Delete
    End If
End Sub
Private Sub UserForm_Initialize()
Me.Caption = "Inserer image"
With CommandButton1
.Caption = "Rechercher image"
.AutoSize = True
End With
With CommandButton2
.Caption = "Supprimer dernière image"
.AutoSize = True
End With
With CommandButton3
.Caption = "Supprimer toutes les images"
.AutoSize = True
End With

cs_Le Pivert · Answer

Ton post m'a donné l'idée de faire un programme où l'on peut sélectionner un dossier complet d'image ou une seule image. Donc si cela t'interesse tu télécharges le programme à cet emplacement.

http://www.vbfrance.com/codes/PLANCHE-CONTACT-SOUS-WORD_53718.aspx

Si tu as des questions à poser je reste à ta disposition

@+Le Pivert

Insérer une image VBA - WORD

19 réponses

Votre réponse

Discussions similaires