Looking for Macro

vivka · #16 02-08-2024, 08:45 AM

Hi, RRB! The following will do the job:

Code:

Sub Replace_Double_Quotes()

    With selection.range.Find
        .text = "([A-z])" & Chr(34) & "([A-z])"
        .Replacement.text = "\1/" & Chr(34) & "\2"
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll
    End With
End Sub

If the quotes in the code are not what is needed, find out the ASCII decimal code of the needed quotes and replace '34' with it.

RRB · #17 02-08-2024, 09:13 AM

I am at lack of the correct words to express my gratitude.

Maybe you know about this:
The TOC field as a switch to look within a certain bookmark i.e '\B "BookMarkName". now the rea that I have bookmarked has Footnotes, But I see all the TC fields that are in the FN are not being picked up by the TOC field. When I select the text to apply the BM it doesn't allow me to select ALSO the FN area. So how can INclude the FN area within the giving BM?

Thanks a million!!

Susan

vivka · #18 02-08-2024, 09:42 AM

Sorry, Susan, my knowledge of TC is very limited! Hopefully, some experts here will help you.

Guessed · #19 02-08-2024, 02:51 PM

Your code is using a string variable called MyText so we can use a string function to replace a string with another string inside that variable

Code:

Sub sss()
  Dim MyText As String
  MyText = Selection.Text
  Selection.Style = ActiveDocument.Styles("MyStyle")
  Debug.Print MyText
  MyText = Replace(MyText, """", "/""")
  Debug.Print MyText
  Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="TC """ & MyText & """ \l 3 ", PreserveFormatting:=False
End Sub

RRB · #20 02-08-2024, 10:38 PM

I now have realized that Vivka's original macro was not using TC fields in the FN, but putting a TC field next to the FN referer in the main text area.

But is there a way to go about this "manually" without using a TC field? I.e. the macro should get all the text(s) of MyStyle **with the page number that they are on** and store the info in a 2-dimensional array and then insert at the end of the document:

TextOfMYstyle--------------------PgNm

(That is what I thought the original macro was doing. I didn't read it well enough)

All help is very appreciated

vivka · #21 02-09-2024, 02:49 AM

You are right, Susan, The macro I proposed works on plain text. Citation: "I need to scan the selected text BEFORE it is inserted by the above macro ... and ONLY THEN inserted into the TC field." So, you can run the macro BEFORE ... Sorry, I couldn't help you!

gmaxey · #22 02-13-2024, 02:41 PM

Susan, has been posting about this particular issue all over the internet in several other forums. I have worked with her offline and I believe the following is what she was after:

Code:

Option Explicit
Dim arrEntries() As String
Sub CreateCompositeTOC_CurrentSection()
Dim oSec As Section
Dim colTCFields As New Collection
Dim colBMs As New Collection
  Set oSec = ActiveDocument.Sections(Selection.Information(wdActiveEndSectionNumber))
  ScanSection oSec, colTCFields, colBMs
  ScanSectionFootNotes oSec, colTCFields, colBMs
  BuildTOCContent colTCFields, colBMs
  DisplayTOC
lbl_Exit:
  Exit Sub
End Sub

Sub BuildTOCContent(colTCFields As Collection, colBMs As Collection)
Dim oRng As Range
Dim lngIndex As Long
Dim strEntry As String

  ReDim arrEntries(colTCFields.Count - 1, 2)
  For lngIndex = 1 To colTCFields.Count
    Set oRng = colTCFields(lngIndex).Code
    strEntry = Right(oRng.Text, Len(oRng.Text) - 5)
    If InStr(strEntry, "\l") > 0 Then
      strEntry = Mid(strEntry, 1, InStr(strEntry, "\l") - 2)
    End If
    strEntry = Replace(strEntry, "/" & Chr(34), Chr(34))
    strEntry = Replace(strEntry, "/" & ChrW(8220), ChrW(8220))
    strEntry = Replace(strEntry, "/" & ChrW(8221), ChrW(8221))
    arrEntries(lngIndex - 1, 0) = strEntry
    arrEntries(lngIndex - 1, 1) = oRng.Information(wdActiveEndAdjustedPageNumber)
    arrEntries(lngIndex - 1, 2) = colBMs.Item(lngIndex)
  Next lngIndex
  'Sort on page number
  WordBasic.SortArray arrEntries(), 0, 0, UBound(arrEntries), 0, 1
  'Sort on entry
  WordBasic.SortArray arrEntries(), 0, 0, UBound(arrEntries), 0, 1
lbl_Exit:
  Exit Sub
End Sub
Sub ScanSection(oSec As Section, colTCFields As Collection, colBMs As Collection)
Dim oFN As Footnote
Dim oField As Field
Dim lngFieldIndex As Long
  lngFieldIndex = 1
   For Each oField In oSec.Range.Fields
     If oField.Type = wdFieldTOCEntry Then
       oField.Code.Bookmarks.Add "Sec_" & oSec.Index & "Fld_" & lngFieldIndex, oField.Code
       colTCFields.Add oField
       colBMs.Add "Sec_" & oSec.Index & "Fld_" & lngFieldIndex
       lngFieldIndex = lngFieldIndex + 1
     End If
   Next oField
lbl_Exit:
  Exit Sub
End Sub
Sub ScanSectionFootNotes(oSec As Section, colTCFields As Collection, colBMs As Collection)
Dim oFN As Footnote
Dim oField As Field
Dim lngIndex As Long
Dim lngFieldIndex
  For lngIndex = 1 To oSec.Range.Footnotes.Count
    Set oFN = oSec.Range.Footnotes(lngIndex)
    lngFieldIndex = 1
    For Each oField In oFN.Range.Fields
      If oField.Type = wdFieldTOCEntry Then
        If oField.Code.Information(wdInFootnote) Then
          oField.Code.Bookmarks.Add "Sec_" & oSec.Index & "FN_" & lngIndex & "Fld_" & lngFieldIndex, oField.Code
          colTCFields.Add oField
          colBMs.Add "Sec_" & oSec.Index & "FN_" & lngIndex & "Fld_" & lngFieldIndex
          lngFieldIndex = lngFieldIndex + 1
        End If
      End If
    Next oField
  Next lngIndex
lbl_Exit:
  Exit Sub
End Sub

Sub DisplayTOC()
Dim oRng As Range
Dim lngIndex As Long
Dim oStyle As Style
Dim oRngHL As Range
Dim oHL As Hyperlink
  On Error Resume Next
  Set oStyle = ActiveDocument.Styles("CompositeTOC")
  If Err.Number <> 0 Then
    ActiveDocument.Styles.Add "CompositeTOC", wdStyleTypeParagraph
    With ActiveDocument.Styles("CompositeTOC")
      .BaseStyle = ActiveDocument.Styles("TOC 1")
      .ParagraphFormat.TabStops.Add Position:=InchesToPoints(6.5), Alignment:=wdAlignTabRight, Leader:=wdTabLeaderDots
      .NextParagraphStyle = ActiveDocument.Styles("CompositeTOC")
    End With
  End If
  On Error GoTo 0
  Set oRng = Selection.Range
  oRng.Style = "CompositeTOC"
  For lngIndex = 0 To UBound(arrEntries)
    oRng.Text = arrEntries(lngIndex, 0) & vbTab & arrEntries(lngIndex, 1) & vbCr
    Set oRngHL = oRng.Duplicate
    oRngHL.End = oRngHL.End - 1
    oRngHL.Hyperlinks.Add oRngHL, , arrEntries(lngIndex, 2)
    oRng.Collapse wdCollapseEnd
    oRngHL.Collapse wdCollapseEnd
  Next lngIndex
lbl_Exit:
  Exit Sub
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Perfect macro not working when its code is inserted in larger macro	RobiNew	Word VBA	3	10-18-2023 03:19 AM
Macro to Remove Paras with Line Spac 6; Macro to Convert Paragraphs to Outline Numbered	venganewt	Word VBA	0	01-25-2022 06:28 PM
Footnote extraction macro [Why is this macro so slow? / anyway to make it faster?]	Le_Blanc	Word VBA	10	03-22-2021 11:38 AM
Spell check macro within macro button field doesn't work in one document	samuelle	Word VBA	0	07-20-2016 02:27 AM
Macro Question: Need help making a macro to highlight the first word in every sentence	LadyAna	Word	1	12-06-2014 10:39 PM