Consulting

Results 1 to 2 of 2

Thread: InsertParagraph at the start of a specific color

  1. #1
    VBAX Newbie
    Joined
    Sep 2017
    Posts
    4
    Location

    InsertParagraph at the start of a specific color

    (EXTREME newbie at VBA....)

    I have a specific task I perform weekly to create a PowerPoint file. Direction is sent as a word document. In the document there are notes for the presenter and the presenter includes text for PowerPoint in Red among the black text.

    I have achieved a macro that extracts the red text and converts it to the font to use for the presentation.

    The formatting gets garbled though. The end result I'd like to have is for each section of red text to be a new paragraph.

    Slides for numbered items are part of the document. There are larger batches of text that I regularly need to adjust formatting on in PowerPoint which I am perfectly fine with continuing to do. Arriving at a "list of slides" from the document sent is a big help as a first step.

    Ultimately, I'd like for this script to start a new PowerPoint file where each paragraph is a slide but I know this is a ways off....I've got plenty to learn before that!

    Because of the extreme newbie status mentioned, I'm assuming that finding the start of the color red and InsertParagraph are necessary components but I can't seem to find anything useful on how to make these ideas work together.

    Thanks in advance!

    Here's my attempt so far:

    Sub ExtractRedText()
    Dim lngColor As Long
     Application.ScreenUpdating = False
     lngColor = Selection.Range.HighlightColorIndex = wdBlack
     With ActiveDocument.Range(0, 0)
       With .Find
         .ClearFormatting
         .Replacement.ClearFormatting
         .Text = ""
         .Replacement.Text = ""
         .Forward = True
         .Wrap = wdFindContinue
         .Format = True
         .Font.Color = lngColor
         .MatchCase = False
         .MatchWholeWord = False
         .MatchWildcards = False
         .MatchSoundsLike = False
         .MatchAllWordForms = False
         .Execute Replace:=wdReplaceAll
                Selection.WholeStory
                Selection.Font.Name = "Bebas Neue Regular"
                Selection.Font.Size = 18
                Selection.Font.TextColor = RGB(0, 0, 0)
            
       End With
     End With
     'UpdateFont = Selection.Range.HighlightColorIndex = wdRed
    
     'Application.ScreenUpdating = True
     End Sub
    Last edited by VABP; 10-28-2018 at 11:13 AM.

  2. #2
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    2,866
    Location
    Sub ScratchMacro()
    'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 10/28/2018
    Dim lngColor As Long
    Dim oRng As Word.Range
    Dim oDoc As Document
    Dim oDocOutput As Document
     Application.ScreenUpdating = False
     'It is important that your either know the color(long) or have a bit of it selected.
     lngColor = Selection.Range.Font.Color
     Set oDoc = ActiveDocument
     Set oDocOutput = Documents.Add
     With oDocOutput.Range
       .Font.Name = "Bebas Neue Regular"
       .Font.Size = 18
       .Font.TextColor = RGB(0, 0, 0)
     End With
     Set oRng = oDoc.Range
     With oRng.Find
       .ClearFormatting
       .Format = True
       .Font.Color = lngColor
       While .Execute
         oDocOutput.Range.InsertAfter oRng & vbCr
         oRng.Collapse wdCollapseEnd
       Wend
      End With
      oDocOutput.Range.Paragraphs.Last.Range.Delete
      oDocOutput.Activate
      Application.ScreenUpdating = True
    lbl_Exit:
      Exit Sub
    End Sub
    Greg

    Visit my website: http://gregmaxey.com

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •