اذهب الي المحتوي
بحث مخصص من جوجل فى أوفيسنا
Custom Search
جمال جبريل

سؤال اضافة اشارات مرجعية بناء على معلومات من جدول

Recommended Posts

انا لدي ماكروا يستخرج كل الاشارات المرجعية من مستند الي جدول في اخر الصفحة ، وفيها اسم الاشارة المرجعية ، ورقم الصفحة ، ورقم السطر ، ورقم المقطع ، واريد ان يكون هذا الامر بالعكس، اي من خلال هذا الجدول اريد ان اضيف الاشارات المرجعية من خلال هذا الجدول والمعلومات المضافة اليها ، الماكروا موجود داخل المستند

Sub ExtractBookmarksInSameDoc()
  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."wink_3
  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 objDoc.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 = "Sections"
      .Cell(1, 3).Range.Text = "Page Number"
        .Cell(1, 4).Range.Text = "lines"
        .Cell(1, 5).Range.Text = "Colm"
      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.Information(wdActiveEndSectionNumber)
        .Cell(nRow, 3).Range.Text = objBookmark.Range.Information(wdActiveEndAdjustedPageNumber)
        .Cell(nRow, 4).Range.Text = objBookmark.Range.Information(wdFirstCharacterLineNumber) '
        '(wdVerticalPositionRelativeToPage)
        '(wdFirstCharacterLineNumber)
        
        .Cell(nRow, 5).Range.Text = objBookmark.Range.Information(wdVerticalPositionRelativeToPage)
        '(wdStartOfRangeColumnNumber)'(wdHorizontalPositionRelativeToTextBoundary)'(wdActiveEndAdjustedPageNumber)'(wdActiveEndAdjustedPageNumber)
        
        objDoc.Hyperlinks.Add Anchor:=.Cell(nRow, 3).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

سؤال لادراج الاشارات المرجعية برقم الصفحة ورقم السطر.rar

شارك هذه المشاركه


رابط المشاركه
شارك

السلام عليكم

حاولت تطبيق الماكرو لكن أعطاني إشارة بوجود مشكلة.

يرجى إرفاق الماكرو بملف text

دمتم بخير

شارك هذه المشاركه


رابط المشاركه
شارك

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

سجل دخولك الان

  • المتواجدين الان   0 اعضاء متواجدين الان

    لايوجد اعضاء مسجلون يتصفحون هذه الصفحه

×