VBA : Importation signets

Bonjour à toutes et à tous,


La macro ci-dessous est censée rapatrier 4 mots non contigus et des
signets d'un document word dans un classeur excel.

Les signets sont bien présents dans le document word.
Le document est protégé (formulaire). Mais ça ne change rien que la=

protection soit enlevée ou pas.

Le texte entre les signets "Section1" et "Section1b" est bien importé
dans la cellule (1,dc) mais ensuite à la ligne Cells(2,dc) la macro =

plante en mettant le message d'erreur suivant :

Erreur d'exécution '5941' : Le membre de la collection requis n'existe =
pas.

Les références activées sont :
Visual Basic For Applications
Microsoft Excel 11.0 Object Library
OLE Automation
Microsoft Office 11.0 Object Library
Microsoft Word 11.0 Object Library

Malgré plusieurs essais de modifications du code, il y a toujours la
même erreur et je ne vois pas du tout d'où vient le problème. Si un=
e âme
charitable pouvait m'expliquer la source de cette erreur Je l'en
remercie grandement d'avance.


Sub recup_signets()

'variables
Dim wdApp As New Word.Application
Dim WordDoc As Word.Document
Dim FileToOpen
Dim n As Integer
Dim bm As String
Dim dc As Integer
Dim nbrows As Integer

'Ouverture document word
FileToOpen = Application.GetOpenFilename("Nom fichier,*.doc")

If FileToOpen = False Then
Exit Sub
Else
Set WordDoc = wdApp.Documents.Open(FileToOpen)
'wdApp.Visible = True
nbrows = ActiveDocument.Tables(1).Rows.Count - 1
On Error Resume Next
ActiveDocument.Unprotect
On Error GoTo 0
End If

'Recherche de la colonne utile
Sheets("List_Signet").Select
Range("A1").Select
dc = Sheets("List_Signet").Range("IV1").End(xlToLeft).Column + 1

'Importation texte 1
Cells(1, dc) = WordDoc.Range(WordDoc.Bookmarks("Section1").Range.Start,=

WordDoc.Bookmarks("Section1b").Range.End).Text

'Beauté
Sheets("List_Signet").Columns(dc).EntireColumn.AutoFit

'Importation des 3 autres textes (si présents)
If nbrows = 0 Then GoTo saute

Cells(2, dc) = WordDoc.Range(WordDoc.Bookmarks("Nb1").Range.Start,
WordDoc.Bookmarks("Nb1b").Range.End).Text
Cells(3, dc) = WordDoc.Range(WordDoc.Bookmarks("Nb2").Range.Start,
WordDoc.Bookmarks("Nb2b").Range.End).Text
Cells(4, dc) = WordDoc.Range(WordDoc.Bookmarks("Nb3").Range.Start,
WordDoc.Bookmarks("Nb3b").Range.End).Text

saute:

'Importation des autres signets
For n = 5 To 104
bm = Cells(n, 2).Value
Cells(n, dc) = WordDoc.Bookmarks(bm).Range.Text
Next n

'Quitte Word
Set WordDoc = Nothing
wdApp.Quit

Set wdApp = Nothing

End Sub

Merci pour l'aide à un blaireau en détresse.
Daniel

---

• Partager ce contenu :