XL 2010 signet image word page 2 ne fonctionne pas

[herve62]

Bonjour
J'avais bien fait l'insertion d'une signature en image dans word
Mais là si je passe à une autre page cela ne fonctionne plus ? erreur à : Set Img = .InlineShapes.AddPicture(FichierImage, False, True)
et là je sèche , j'ai testé en mettant un signet texte en page 2 et pas de Pb
J'ai cherché mais rien trouvé sur ce sujet
Donc là je cherche un expert !!!! qui aurait la solution
Bien merci

Correction : AJOUT du bon dossier

 

[laurent950]

Bonjour @herve62, @job75
' Votre Signet Signature est encapsuler dans une Shape (Zone de Texte)
' WordDoc.Shapes.Item("Text Box 3")
' il y a une Erreur Automation a cause de cela, car il faut en premier lieux sélectionner cette Shape, pour ensuite y coller le signet (image) à l'intérieur de celui-ci

' Nota : Il y a un décalage et donc l'image est rogné à l'intérieur de celle-ci.
'
Pour avoir les bonnes dimension dans la zone de signet (Image) / Zone Shape Texte
'
Code si dessous
'

Function ConvertPointToCm(ByVal pnt As Double) As Double
    ConvertPointToCm = pnt * 0.03527778
End Function

'

Function ConvertCmToPoint(ByVal cm As Double) As Double
    ConvertCmToPoint = cm * 28.34646
End Function

'

Sub test()
'nécéssite d'activer la référence Microsoft Word xx.x Object Library
Dim WordApp As Word.Application ' NE PAS OUBLIER DE PRECISER WORD pour EXCEL
'
On Error Resume Next
' Initialisation de Word
    Set WordApp = GetObject(, "Word.Application")
    If Err <> 0 Then
        Err.Clear
        Set WordApp = CreateObject("Word.Application")
        If Err <> 0 Then
            MsgBox "La macro n'a pas pu ouvrir !", vbExclamation
            End
        End If
    End If
On Error GoTo 0
'
    WordApp.Visible = True
'
Dim WordDoc As Word.Document
Dim rg As Word.Range
Dim Img As Word.InlineShape

Dim Chemin As String
    Chemin = ThisWorkbook.Path & "\"
Dim Fichier As String
    Fichier = "02-fichier word2.docx"
Dim nom_societe As String
Dim FichierImage As String
    FichierImage = ThisWorkbook.Path & "\SignCD.jpg"
Dim NomSignet As String
    NomSignet = "signature"
Dim HauteurImg As Variant
Dim LargeurImg As Variant
' Nouveau fichier enregistrer sous
Dim NomDoc As String
    NomDoc = ThisWorkbook.Path & "\Sign_word.docx" ' définition du chemin et nom du doc au créer
'
Set WordDoc = WordApp.Documents.Open(ThisWorkbook.Path & "\" & Fichier)
    With WordDoc
        If .Bookmarks.Exists(NomSignet) Then
            Set rg = WordDoc.Bookmarks(NomSignet).Range
                rg.Select ' car le signet et dans une zone de texte
                HauteurImg = WordDoc.Shapes.Item("Text Box 3").Height * 0.03527778 ' en cm
                LargeurImg = WordDoc.Shapes.Item("Text Box 3").Width * 0.03527778  ' en cm
            Set Img = .InlineShapes.AddPicture(FichierImage, False, True, rg)
                Img.Height = HauteurImg * 28.34646
                Img.Width = LargeurImg * 28.34646
            End If
       .SaveAs NomDoc ' On l'enregistre ? là le doc est vide
    End With
WordDoc.Close
Set WordDoc = Nothing
WordApp.Quit
Set WordApp = Nothing
End Sub