Remplacer une image dans word à partir d'excel

B

bahhbouh

XLDnaute Nouveau
Bonjour à tous, après avoir fait moult recherches, je suis tjrs bloqué et je demande votre aide.

Voila j'essaye à l'aide d'une macro qui se trouve dans fichier excel de modifier un fichier word ex: chercher et remplacer des mots et remplacer des images...

Et donc j'arrive à ouvrir le fichier word, à faire les recherches et remplacement des mots, à sauvegarder dans un dossier spécifique et à fermer word.

Ce que je n'arrive tjrs pas à faire, c'est de sélectionner une image et la faire remplacer par une autre, pour ce faire un dialogbox doit apparaître pour qu'on sélectionne la nouvelle image puis la nouvelle image doit être centré puis encadré.

En fait j'arrive à faire la macro en word, mais qd j'essaye de l'adapter pour qu'elle fonctionne sur excel rien ne va.

Merci d'avance.
Wicem
 
Trier par date Trier par votes
B

bahhbouh

XLDnaute Nouveau
Re : Remplacer une image dans word à partir d'excel

La macro qui fonctionne sur word:

Code: 
Sub Macro4()
'
' Macro4 Macro
'
'

    ActiveDocument.Shapes("Rectangle 42").Select
    Selection.ShapeRange.Fill.Transparency = 0#
    Selection.ShapeRange.Line.Weight = 0.75
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoTrue
    Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0)
    Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.Rotation = 0#
    Selection.ShapeRange.Left = 159#
    Selection.ShapeRange.Top = 291.1
    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 255)
    Selection.ShapeRange.Fill.BackColor.RGB = RGB(255, 255, 255)
     ''ici je veux qu'il ouvre un dialogBox pour que je choisi la nouvelle image
    Selection.ShapeRange.Fill.UserPicture _
           "C:\Documents and Settings\cbvabsa\My Documents\My Pictures\images.jpeg"
    Selection.ShapeRange.RelativeHorizontalPosition = _
        wdRelativeHorizontalPositionColumn
    Selection.ShapeRange.RelativeVerticalPosition = _
        wdRelativeVerticalPositionParagraph
    Selection.ShapeRange.RelativeHorizontalSize = wdRelativeHorizontalSizePage
    Selection.ShapeRange.RelativeVerticalSize = wdRelativeVerticalSizePage
    Selection.ShapeRange.Left = CentimetersToPoints(3.61)
    Selection.ShapeRange.LeftRelative = wdShapePositionRelativeNone
    Selection.ShapeRange.Top = CentimetersToPoints(0.17)
    Selection.ShapeRange.TopRelative = wdShapePositionRelativeNone
    Selection.ShapeRange.WidthRelative = wdShapeSizeRelativeNone
    Selection.ShapeRange.HeightRelative = wdShapeSizeRelativeNone
    Selection.ShapeRange.LockAnchor = False
    Selection.ShapeRange.LayoutInCell = True
    Selection.ShapeRange.WrapFormat.AllowOverlap = True
    Selection.ShapeRange.WrapFormat.Side = wdWrapBoth
    Selection.ShapeRange.WrapFormat.DistanceTop = CentimetersToPoints(0)
    Selection.ShapeRange.WrapFormat.DistanceBottom = CentimetersToPoints(0)
    Selection.ShapeRange.WrapFormat.DistanceLeft = CentimetersToPoints(0.32)
    Selection.ShapeRange.WrapFormat.DistanceRight = CentimetersToPoints(0.32)
    Selection.ShapeRange.WrapFormat.Type = wdWrapTopBottom
End Sub

Et sur excel, ben j'y arrive pas donc j'ai rien de tout, j'ai bêtement copier coller :D
 
Vote positif 0 Vote négatif
mromain

mromain

XLDnaute Barbatruc
Re : Remplacer une image dans word à partir d'excel

Re bonjour,

Voici un essai (il faut adapter le chemin du fichier word) :
VB: 
Sub Macro4()
Dim appWord As Object, docWord As Object, rectangle As Object

    'créer une instance de word
    Set appWord = CreateObject("Word.Application")
    
    'rendre l'application Word visible (mettre false pour la cacher)
    appWord.Visible = True
    
    'ouvrir le document Word (celui à modifier)
    Set docWord = appWord.Documents.Open("E:\Doc1.doc")
    
   'récupérer le rectangle ("Rectangle 42") du document Word
    Set rectangle = docWord.Shapes("Rectangle 42")
    
    'effectuer l'ensemble des opérations sur ce rectangle
    With rectangle
        .Fill.Transparency = 0#
        .Line.Weight = 0.75
        .Line.DashStyle = msoLineSolid
        .Line.Style = msoLineSingle
        .Line.Transparency = 0#
        .Line.Visible = msoTrue
        .Line.ForeColor.RGB = RGB(0, 0, 0)
        .Line.BackColor.RGB = RGB(255, 255, 255)
        .LockAspectRatio = msoFalse
        .Rotation = 0#
        .Left = 159#
        .Top = 291.1
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(255, 255, 255)
        .Fill.BackColor.RGB = RGB(255, 255, 255)
        .Fill.UserPicture Application.GetOpenFilename("Fichier Image, *.jpeg;*.jpg;*.gif;*.bmp;*.png", , "Image à insérer :")
        .RelativeHorizontalPosition = 2
        .RelativeVerticalPosition = 2
        .RelativeHorizontalSize = 1
        .RelativeVerticalSize = 1
        .Left = appWord.CentimetersToPoints(3.61)
        .LeftRelative = -999999
        .Top = appWord.CentimetersToPoints(0.17)
        .TopRelative = -999999
        .WidthRelative = -999999
        .HeightRelative = -999999
        .LockAnchor = False
        .LayoutInCell = True
        .WrapFormat.AllowOverlap = True
        .WrapFormat.Side = 0
        .WrapFormat.DistanceTop = appWord.CentimetersToPoints(0)
        .WrapFormat.DistanceBottom = appWord.CentimetersToPoints(0)
        .WrapFormat.DistanceLeft = appWord.CentimetersToPoints(0.32)
        .WrapFormat.DistanceRight = appWord.CentimetersToPoints(0.32)
        .WrapFormat.Type = 4
    End With
End Sub
a+
 
Dernière édition:
Vote positif 0 Vote négatif
B

bahhbouh

XLDnaute Nouveau
Re : Remplacer une image dans word à partir d'excel

Encore une petite remarque, j'essaye d'éliminer tout risque de bug, et qd excel me demande de sélectionner la nouvelle image et je clic sur "cancel" il me met un message d'erreur comme quoi il n'a pas trouvé d'image, alors comment passer à l'étape suivante en affichant un message "Aucune image n'a été sélectionné" et 2 boutons: "continuer sans modifier l'image" et "sélectionner une image".
Encore merci.
 
Vote positif 0 Vote négatif
mromain

mromain

XLDnaute Barbatruc
Re : Remplacer une image dans word à partir d'excel

Bonjour bahhbouh,


Voici un essai (pas très propre, mais qui a l'air de fonctionner) :
VB: 
Sub Macro4()
Dim appWord As Object, docWord As Object, rectangle As Object, fichierImg As String

    'créer une instance de word
    Set appWord = CreateObject("Word.Application")
    
    'rendre l'application Word visible (mettre false pour la cacher)
    appWord.Visible = True
    
    'ouvrir le document Word (celui à modifier)
    Set docWord = appWord.Documents.Open("E:\Doc1.doc")
    
   'récupérer le rectangle ("Rectangle 42") du document Word
    Set rectangle = docWord.Shapes("Rectangle 42")
    
    'effectuer l'ensemble des opérations sur ce rectangle
    With rectangle
        .Fill.Transparency = 0#
        .Line.Weight = 0.75
        .Line.DashStyle = msoLineSolid
        .Line.Style = msoLineSingle
        .Line.Transparency = 0#
        .Line.Visible = msoTrue
        .Line.ForeColor.RGB = RGB(0, 0, 0)
        .Line.BackColor.RGB = RGB(255, 255, 255)
        .LockAspectRatio = msoFalse
        .Rotation = 0#
        .Left = 159#
        .Top = 291.1
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(255, 255, 255)
        .Fill.BackColor.RGB = RGB(255, 255, 255)
ChoixFichier:
        fichierImg = Application.GetOpenFilename("Fichier Image, *.jpeg;*.jpg;*.gif;*.bmp;*.png", , "Image à insérer :")
        If fichierImg = "Faux" Then
            If MsgBox("Aucune image n'est sélectionnée." & vbNewLine & "Voulez-vous sélectionner une autre image ?", vbYesNo, "Erreur") = vbYes Then GoTo ChoixFichier
        Else
            .Fill.UserPicture fichierImg
        End If
        .RelativeHorizontalPosition = 2
        .RelativeVerticalPosition = 2
        .RelativeHorizontalSize = 1
        .RelativeVerticalSize = 1
        .Left = appWord.CentimetersToPoints(3.61)
        .LeftRelative = -999999
        .Top = appWord.CentimetersToPoints(0.17)
        .TopRelative = -999999
        .WidthRelative = -999999
        .HeightRelative = -999999
        .LockAnchor = False
        .LayoutInCell = True
        .WrapFormat.AllowOverlap = True
        .WrapFormat.Side = 0
        .WrapFormat.DistanceTop = appWord.CentimetersToPoints(0)
        .WrapFormat.DistanceBottom = appWord.CentimetersToPoints(0)
        .WrapFormat.DistanceLeft = appWord.CentimetersToPoints(0.32)
        .WrapFormat.DistanceRight = appWord.CentimetersToPoints(0.32)
        .WrapFormat.Type = 4
    End With
End Sub
a+
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

A
  • Question
XL 2016 Adapter une image à une cellule
2
Réponses
16
Affichages
1 K
Dudu2
Dudu2
S
  • Question
XL 2010 Suppression d'un ligne sur word à partir d'excel VBA
Réponses
1
Affichages
308
Staple1600
Staple1600
C
  • Question
Autres Dans Excel, à partir d'un UserForm, copier l'adresse sélectionnée dans enveloppe de publipostage Word et ouvrir la fenêtre "aperçu avant impression"
Réponses
11
Affichages
435
Chatron
C
F
  • Question
XL 2019 Remplissage de champs dans doc Word à partir d'excel
Réponses
4
Affichages
561
Staple1600
Staple1600
M
  • Résolu(e)
Microsoft 365 Image stockée dans une feuille à l'initialisation du userform
2
Réponses
20
Affichages
1 K
meyscal
M
E
  • Question
XL 2013 Insérer dans un USF une image qui est dans une feuille
2 3 4
Réponses
50
Affichages
2 K
patricktoulon
patricktoulon
L
  • Question
Microsoft 365 Code VBA pour commencer publipostage à partir d'un .dotx
Réponses
5
Affichages
944
Law0179
L
T
  • Question
Microsoft 365 Insérer une image à fond transparent à format png dans un Userform
2
Réponses
18
Affichages
2 K
patricktoulon
patricktoulon
C
  • Question
XL 2021 case à cocher dans ListView impacte une cellule de feuille
Réponses
1
Affichages
560
fanch55
fanch55
R
  • Question
XL 2010 Autoriser collage image sur une feuille protégée
Réponses
9
Affichages
2 K
rosabelle
R

Membres actuellement en ligne

6 membres et 55 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 379
Messages
2 087 770
Membres
103 662
dernier inscrit
rterterert