Macro copie dans word si le signet existe
A
Bonsoir à tous,
J'ai un problème pour exécuter une macro qui a pour objectif de copier un tableau excel dans un document word uniquement si le signet relié existe bien dans le fichier ouvert. Lorsque je teste le code ci-dessous j'ai un souci avec "doc.bookmarks.Exists(A)".
L'objectif final du code est de pouvoir copier-coller plusieurs tableaux situés sur plusieurs feuilles, l'opération devra donc être répétée beaucoup de fois.
En vous remerciant par avance pour votre aide
Alaise_Blaise
Sub Copie_word()
'
' Copie_word Macro
'
Dim Wd As Object
Dim doc As Document
'Empêche le rafraîchissement de l'écran du moniteur
Application.ScreenUpdating = False
'Capter l'instance de l'application Word qui est ouverte
Set Wd = GetObject(, "Word.Application")
Set doc = ActiveDocument
'Avec la feuille de calcul de l'application Excel
With Worksheets("Feuill1")
'Avec la plage B30:D74
With .Range("B30:D74")
'Copier dans le presse-papier la cellule
.Copy
End With
End With
If doc.Bookmarks.Exists(A) Then
With Wd
.Selection.Goto what:=-1, Name:="Test2"
.Selection.Paste
End With
End If
End SubE
Bonjour,
Un exemple à adapter :
Sub EnvoyerDonneesExcelVersWord()
Dim oWdApp As Word.Application, oWdDoc As Word.Document ' En early binding (Si Word est référencé)
' Dim oWdApp As Object, oWdDoc As Object ' En late binding
Dim Repertoire As String, NomDuDocument As String
Dim AireMateriel As Range
On Error GoTo FinWord
Set AireMateriel = Range("Matériel")
AireMateriel.Copy
Set oWdApp = CreateObject("Word.Application")
oWdApp.Visible = True
Repertoire = ActiveWorkbook.Path & "\"
NomDuDocument = Repertoire & "Essai.docx"
Set oWdDoc = oWdApp.Documents.Open(NomDuDocument)
With oWdDoc
If .Bookmarks.Count = 0 Then
MsgBox "Absence de signet !", vbCritical
.Close savechanges:=False
GoTo FinWord
End If
If .Bookmarks.Exists("Matériel") = False Then
MsgBox "Absence du signet Matériel !", vbCritical
.Close savechanges:=False
GoTo FinWord
End If
.Bookmarks("Matériel").Select
oWdApp.Selection.PasteSpecial Link:=False, DataType:=0, Placement:=0, DisplayAsIcon:=False
.Close savechanges:=True
End With
Application.CutCopyMode = False
MsgBox "Fin de mise à jour !", vbInformation
GoTo FinWord
FinWord:
oWdApp.Quit
Set AireMateriel = Nothing
Set oWdApp = Nothing
Set oWdDoc = Nothing
End SubA
Bonjour,
Merci beaucoup pour la réponse, c'est parfait