Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 08-28-2017, 08:12 PM
leaning leaning is offline Create document index looking for certain formatted text Windows 7 64bit Create document index looking for certain formatted text Office 2010 64bit
Novice
Create document index looking for certain formatted text
 
Join Date: Jan 2011
Posts: 16
leaning is on a distinguished road
Question Create document index looking for certain formatted text

For PowerPoint, you folks created a macro for me that goes through every text box on every slide, grabs the text that's red and bolded and the slide it's on, and then makes an alphabetized index with that. I use it for college notes and it's worked great. Now, for formatting and other reasons, I've transitioned all the data from 300+ slides to Word. But, if possible, I'd still like to be able to use that type of index. Can anyone assist in modifying this macro to work with Word (look for red bolded text and what pages it's on and create an index) )The index can be created in a separate Word document so it doesn't interfere with the page numbers of the subject document.)?



Regards,
leaning

Code:
Sub StartHere()
    Dim osld As Slide
    Dim oshp As Shape
    Dim rayTitles() As String
    Dim i As Integer
    ReDim rayTitles(1 To 1)
    For Each osld In ActivePresentation.Slides
        For Each oshp In osld.Shapes
            If oshp.HasTextFrame Then
                If oshp.TextFrame.HasText Then
                    For i = 1 To oshp.TextFrame.TextRange.Runs.Count
                        With oshp.TextFrame.TextRange.Runs(i).Font
                            If .Color.RGB = vbRed And .Bold = True Then
                                rayTitles(UBound(rayTitles)) = oshp.TextFrame.TextRange.Runs(i) & "\" & osld.SlideNumber
                                ReDim Preserve rayTitles(1 To UBound(rayTitles) + 1)
                            End If
                        End With
                    Next i
                End If
            End If
        Next oshp
    Next osld
    ReDim Preserve rayTitles(1 To UBound(rayTitles) - 1)
    Call mySort(rayTitles)
    Call make_sum(rayTitles)
End Sub
Function mySort(ArrayIn As Variant) As Variant
    Dim b_Cont As Boolean
    Dim lngCount As Long
    Dim strSwap As String
    Do
        b_Cont = False
        For lngCount = LBound(ArrayIn) To UBound(ArrayIn) - 1
            'If ArrayIn(lngCount) > ArrayIn(lngCount + 1) Then
            If LCase(ArrayIn(lngCount)) > LCase(ArrayIn(lngCount + 1)) Then
                strSwap = ArrayIn(lngCount)
                ArrayIn(lngCount) = ArrayIn(lngCount + 1)
                ArrayIn(lngCount + 1) = strSwap
                b_Cont = True
            End If
        Next lngCount
    Loop Until Not b_Cont
End Function
Sub make_sum(rayInstring As Variant)
    Dim osld As Slide
    Dim i As Integer
    For Each osld In ActivePresentation.Slides
        If osld.Tags("SUM") = "YES" Then
            osld.Delete
            Exit For
        End If
    Next osld
    Set osld = ActivePresentation.Slides.Add(1, ppLayoutText)
    osld.Tags.Add "SUM", "YES"
    osld.Shapes(2).TextFrame2.AutoSize = msoAutoSizeTextToFitShape
    osld.Shapes(2).TextFrame.Ruler.TabStops.Add ppTabStopLeft, 450
    With osld
        For i = 1 To UBound(rayInstring)
            .Shapes(2).TextFrame.TextRange = .Shapes(2).TextFrame.TextRange & Split(rayInstring(i), "\")(0) & " (" & Split(rayInstring(i), "\")(1) & ")" & vbCrLf & vbCrLf
        Next i
    End With
    MsgBox "Done", vbInformation, "Done!"
End Sub
Reply With Quote
  #2  
Old 08-28-2017, 08:58 PM
leaning leaning is offline Create document index looking for certain formatted text Windows 7 64bit Create document index looking for certain formatted text Office 2010 64bit
Novice
Create document index looking for certain formatted text
 
Join Date: Jan 2011
Posts: 16
leaning is on a distinguished road
Default

All,

I found this!
I have a lot of red-boldeds, so it gives the "not responding" message while it is running, so I'd like to add a status indicator, but otherwise, it builds the list, then you click in wherever in your document you want the index to start, References> Insert Index, and POW! Instant Index. I'll have to change the font to smaller and to save paper and flipping through pages, make it so it's 3-4 columns instead of 2, but as it is, it works great! So, unless anyone has anything to improve on this, I'm good. Thanks, Allen Wyatt!

https://wordribbon.tips.net/T010438_..._an_Index.html

Code:
Sub InsertingIndexEntries()
    Application.ScreenUpdating = False

    'Go to the first page of the document
    Selection.HomeKey wdStory, wdMove

    'Set up the Find and Replace operation
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchWildcards = False
        .Font.Bold = True
        .Font.ColorIndex = wdRed ' I added this so it looks for red text
    End With

    'Finds the bold text and inserts an index entry.
    Do
        Selection.Find.Execute
        If Selection.Find.Found Then
            'Checks if the Index field was selected
            'This occurs if it does not contain any entries
            If UCase(Selection.Range.Text) <> "NO INDEX ENTRIES FOUND." Then
                'Insert an index entry and use the text within
                'the selected range as the entry name
                ActiveDocument.Indexes.MarkEntry _
                  Range:=Selection.Range, _
                  Entry:=Selection.Range.Text, _
                  EntryAutoText:=Selection.Range.Text, _
                  CrossReference:="", _
                  CrossReferenceAutoText:="", _
                  BookmarkName:="", _
                  Bold:=False, _
                  Italic:=False, _
                  Reading:=""
                'Move past text that was found and the new index entry
                Selection.MoveRight wdCharacter, 1, wdExtend
                Selection.Collapse wdCollapseEnd
            End If
        End If
    Loop While Selection.Find.Found

    Application.ScreenUpdating = True
    Application.ScreenRefresh
    MsgBox "Done"
End Sub
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Create document index looking for certain formatted text How do I create an index of every word in a document? jbengal Word 5 11-23-2022 02:17 PM
Create document index looking for certain formatted text Pasted text is not formatted correctly in protected document Lena Word 3 04-19-2017 05:32 AM
Macro to keep formatted form fields after mail merge or replace text with formatted form fields jer85 Word VBA 2 04-05-2015 10:00 PM
Create document index looking for certain formatted text Underlined Purple Text and "formatted" boxes at side of document SeanCGR Word 1 06-20-2014 06:49 AM
How to create an Index for an existing document JimAlexander Word 0 11-10-2013 11:19 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 06:28 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft