VBA : Importation signets

Le
danielos
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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichD
Le #26370389
Bonjour,

'------------------------------
On Error Resume Next
ActiveDocument.Unprotect
On Error GoTo 0
'------------------------------

Remplace ce qui précède par ceci :
WordDoc.Unprotect

Si tu désactives la gestion d'erreur, la procédure va t'indiquer quelle ligne de code est
problématique.

Es-tu certain que tous les signets de ta procédure existent bien dans le document que tu ouvres?

Que va-t-il se passer si une des cellules est vide ou ne représente pas un signet ici dans ton code?

bm = Cells(n, 2).Value
Cells(n, dc) = WordDoc.Bookmarks(bm).Range.Text
danielos
Le #26370414
Désolé de répondre dans ton message mais cela permet d'apporter les
réponses à tes questions.

MichD a écrit :
Bonjour,


Bonsoir MichD

'------------------------------
On Error Resume Next
ActiveDocument.Unprotect
On Error GoTo 0
'------------------------------

Remplace ce qui précède par ceci :
WordDoc.Unprotect

Si tu désactives la gestion d'erreur, la procédure va t'indiquer qu elle
ligne de code est problématique.



C'est la ligne qui commence par Cells(2,dc)=....

Es-tu certain que tous les signets de ta procédure existent bien dans le
document que tu ouvres?



Oui ils y sont bien tous
Que va-t-il se passer si une des cellules est vide ou ne représente p as
un signet ici dans ton code?

bm = Cells(n, 2).Value
Cells(n, dc) = WordDoc.Bookmarks(bm).Range.Text



Si un signet est vide .... Rien il n'y aura rien dans la cellule du
classeur.
S'il manque un signet... la macro plante sur la ligne ;
"Cells(n, dc) = WordDoc.Bookmarks(bm).Range.Text"
avec le même message d'erreur :
Erreur d'exécution '5941' : Le membre de la collection requis n'existe pas
Je vais donc regarder encore du côté de mes signets.
Merci de la piste ;-)
danielos
Le #26370417
En fait c'était bien une erreur qui portait sur le nom de mes signets
dans le code. "Nb1b" à la place de "N1b".
grrrhh ; tant d'heures à chercher. Merci MichD pour m'avoir mis sur la
piste.
Bonne soirée à toutes te à tous.


danielos a écrit :
Désolé de répondre dans ton message mais cela permet d'apporter l es
réponses à tes questions.

MichD a écrit :
Bonjour,


Bonsoir MichD

'------------------------------
On Error Resume Next
ActiveDocument.Unprotect
On Error GoTo 0
'------------------------------

Remplace ce qui précède par ceci :
WordDoc.Unprotect

Si tu désactives la gestion d'erreur, la procédure va t'indiquer
quelle ligne de code est problématique.



C'est la ligne qui commence par Cells(2,dc)=....

Es-tu certain que tous les signets de ta procédure existent bien dan s
le document que tu ouvres?



Oui ils y sont bien tous
Que va-t-il se passer si une des cellules est vide ou ne représente
pas un signet ici dans ton code?

bm = Cells(n, 2).Value
Cells(n, dc) = WordDoc.Bookmarks(bm).Range.Text



Si un signet est vide .... Rien il n'y aura rien dans la cellule du
classeur.
S'il manque un signet... la macro plante sur la ligne ;
"Cells(n, dc) = WordDoc.Bookmarks(bm).Range.Text"
avec le même message d'erreur :
Erreur d'exécution '5941' : Le membre de la collection requis n'exist e pas
Je vais donc regarder encore du côté de mes signets.
Merci de la piste ;-)



MichD
Le #26370421
Si tu veux importer tous les signets du document Word que tu as ouvert à partir d'Excel


Dim Bk As Word.Bookmark, A As Long

For Each Bk In WordDoc.Bookmarks
With worksheets("Feuil1") 'Onglet feuille à adapter
A = A + 1
'Adresse première cellule à adapter
.Range("A" & A) = Bk.Range.Text
End With
Next
Publicité
Poster une réponse
Anonyme