Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

VBA : Importation signets

4 réponses
Avatar
danielos
Bonjour =E0 toutes et =E0 tous,


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

Les signets sont bien pr=E9sents dans le document word.
Le document est prot=E9g=E9 (formulaire). Mais =E7a ne change rien que la=
=20
protection soit enlev=E9e ou pas.

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

plante en mettant le message d'erreur suivant :

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

Les r=E9f=E9rences activ=E9es 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=E9 plusieurs essais de modifications du code, il y a toujours la=20
m=EAme erreur et je ne vois pas du tout d'o=F9 vient le probl=E8me. Si un=
e =E2me=20
charitable pouvait m'expliquer la source de cette erreur ... Je l'en=20
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 =3D Application.GetOpenFilename("Nom fichier,*.doc")

If FileToOpen =3D False Then
Exit Sub
Else
Set WordDoc =3D wdApp.Documents.Open(FileToOpen)
'wdApp.Visible =3D True
nbrows =3D 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 =3D Sheets("List_Signet").Range("IV1").End(xlToLeft).Column + 1

'Importation texte 1
Cells(1, dc) =3D WordDoc.Range(WordDoc.Bookmarks("Section1").Range.Start,=
=20
WordDoc.Bookmarks("Section1b").Range.End).Text

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

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

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

saute:

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

'Quitte Word
Set WordDoc =3D Nothing
wdApp.Quit

Set wdApp =3D Nothing

End Sub

Merci pour l'aide =E0 un blaireau en d=E9tresse.
Daniel

4 réponses

Avatar
MichD
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
Avatar
danielos
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 ;-)
Avatar
danielos
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 ;-)



Avatar
MichD
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