View Single Post
 
Old 08-03-2021, 04:32 AM
Guessed's Avatar
Guessed Guessed is offline Windows 10 Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 4,176
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

Assuming you are planning on putting a complete Torah table at the end of the document as the reference, you could use code like I did in your sample doc. It reads from the final table in the document. Note that it doesn't appear to pick up every sentence in your sample - I'm not sure why but it could have something to do with RTL languages or subtle differences (like a space or comma) in the text not exactly matching the cell text.
Code:
Sub TagText()
  Dim aTbl As Table, aRng As Range, aRow As Row, rngHit As Range, aFld As Field
  Dim sFind As String, sID As String, sClause As String, sRef As String, rngBk As Range
  Set aTbl = ActiveDocument.Tables(ActiveDocument.Tables.Count)
  Set aRng = ActiveDocument.Range(Start:=0, End:=aTbl.Range.Start - 1)
  For Each aRow In aTbl.Rows
    Debug.Print aRow.Cells(1).Range.Text
    sID = Split(aRow.Cells(3).Range.Text, vbCr)(0)
    sClause = Split(aRow.Cells(2).Range.Text, vbCr)(0)
    sFind = Split(aRow.Cells(1).Range.Text, vbCr)(0)
    sRef = "Clause_" & sID
    
    'enable one of the following rows
    'Set rngBk = aRow.Cells(3).Range       'puts id number in ref
    Set rngBk = aRow.Cells(2).Range       'puts middle column in ref
    
    rngBk.End = rngBk.End - 1
    ActiveDocument.Bookmarks.Add Name:=sRef, Range:=rngBk
    
    With aRng.Find
      .ClearFormatting
      .Text = sFind
      Do While .Execute
        aRng.Collapse Direction:=wdCollapseEnd
        Set aFld = ActiveDocument.Fields.Add(Range:=aRng, Text:="Ref " & sRef & " \h")
        aRng.InsertBefore "("
        aRng.End = aFld.Result.End + 1
        aRng.InsertAfter ")"
        aRng.Style = wdStyleFootnoteReference
        aRng.Collapse Direction:=wdCollapseEnd
        aRng.End = aTbl.Range.Start
      Loop
    End With
  Next aRow
End Sub

Sub KillTags()
  With ActiveDocument.Range.Find
    .ClearFormatting
    .Text = ""
    .Style = wdStyleFootnoteReference
    .Replacement.Text = " "
    .Execute Replace:=wdReplaceAll
  End With
End Sub
Attached Files
File Type: docm EXAMPLE.docm (32.9 KB, 7 views)
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote