1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41
| Option Explicit
Sub Liste_Bmks()
Dim AppWord As Object
Dim DocWord As Object
Dim bmk As Object
Dim sChemin As String
Dim i As Long
Dim FD As FileDialog
Set FD = Application.FileDialog(msoFileDialogFilePicker)
With FD
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Documents Word", "*.doc*; *.dot*", 1
If .Show <> -1 Then Exit Sub
sChemin = .SelectedItems(1)
End With
With Feuil2
.Activate
.Cells.Clear
End With
Application.ScreenUpdating = False
Set AppWord = CreateObject("Word.Application")
Set DocWord = AppWord.Documents.Open(Filename:=sChemin)
i = 0
For Each bmk In DocWord.Range.Bookmarks
i = i + 1
Feuil2.Range("A" & i) = bmk.Name
Next bmk
AppWord.Quit
Set DocWord = Nothing
Set AppWord = Nothing
Feuil2.Range("B1").Select
Application.ScreenUpdating = True
End Sub |
Partager