تحميل محتوى الموضوع
عرض نسخة صالحة للطباعة
أرسل هذا الموضوع إلى صديق
انا لدي ماكروا يستخرج كل الاشارات المرجعية من مستند الي جدول في اخر الصفحة ، وفيها اسم الاشارة المرجعية ، ورقم الصفحة ، ورقم السطر ، ورقم المقطع ، واريد ان يكون هذا الامر بالعكس، اي من خلال هذا الجدول اريد ان اضيف الاشارات المرجعية من خلال هذا الجدول والمعلومات المضافة اليها ، الماكروا موجود داخل المستند
Sub ExtractBookmarksInADoc()
Dim objBookmark As Bookmark
Dim objTable As Table
Dim nRow As Integer
Dim objDoc As d*ocument, objNewDoc As d*ocument
Dim objParagraph As Paragraph
Set objDoc = Actived*ocument
If objDoc.Bookmarks.Count = 0 Then
MsgBox ("There is no bookmark in this d*ocument.")
Else
Set objNewDoc = d*ocuments.Add
Selection.TypeText Text:="Bookmarks in " & "'" & objDoc.Name & "'"
Set objTable = Selection.Tables.Add(Range:=Selection.Range, numrows:=1, numcolumns:=5)
objTable.Borders.Enable = True
nRow = 1
For Each objParagraph In objNewDoc.Paragraphs
If objParagraph.Range.Style = "Caption" Then
objParagraph.Range.Delete
End If
Next objParagraph
With objTable
.Cell(1, 1).Range.Text = "Name"
.Cell(1, 2).Range.Text = "Texts"
.Cell(1, 3).Range.Text = "Section"
.Cell(1, 4).Range.Text = "Page Number"
.Cell(1, 5).Range.Text = "lines"
For Each objBookmark In objDoc.Bookmarks
objTable.Rows.Add
nRow = nRow + 1
.Cell(nRow, 1).Range.Text = objBookmark.Name
.Cell(nRow, 2).Range.Text = objBookmark.Range.Text
.Cell(nRow, 3).Range.Text = objBookmark.Range.Information(wdActiveEndSectionNumber)
.Cell(nRow, 4).Range.Text = objBookmark.Range.Information(wdActiveEndAdjustedPageNumber)
.Cell(nRow, 5).Range.Text = objBookmark.Range.Information(wdFirstCharacterLineNumber)
objDoc.Hyperlinks.Add Anchor:=.Cell(nRow, 5).Range, Address:=objDoc.Name, _
SubAddress:=objBookmark.Name, TextToDisplay:=.Cell(nRow, 3).Range.Text
Next objBookmark
End With
End If
objNewDoc.SaveAs2 FileName:=objDoc.Path & "" & "Bookmarks in " & objDoc.Name
End Sub
أعجبني أعجبك هذاإلغ اعجابي 0
