VBA : Importation signets

Le
danielos
Bonjour toutes et tous,


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

Les signets sont bien prsents dans le document word.
Le document est protg (formulaire). Mais a ne change rien que la=

protection soit enleve 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'excution '5941' : Le membre de la collection requis n'existe =
pas.

Les rfrences actives 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
mme erreur et je ne vois pas du tout d'o vient le problme. 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 prsents)
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 dtresse.
Daniel
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