Is there a way to run this macro in Word, without Word opening other windows and flashing

Question

Here is a test example you will need to markup in Word, so that the bold words have the style "heading1".

The macro will split the document at the headings into individual .rtf files that will use the bold heading as the filename + .rtf extension.

hadrotes

paragraph of text here

perisseia

paragraph of text here

perisseuma

paragraph of text here

Sub SplitDocOnHeading1ToRtfWithoutHeadingInOutput()
'Splits the document on Heading1 style, into new documents, Heading1 is  included in the data.



Application.ScreenUpdating = False
Dim Rng As Range, DocSrc As Document, DocTgt As Document
Dim i As Long, StrTxt As String: Const StrNoChr As String = """*/\:?|"
Set DocSrc = ActiveDocument
With DocSrc.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Format = True
    .Forward = True
    .Text = ""
    .Style = wdStyleHeading1
    .Replacement.Text = ""
    .Wrap = wdFindStop
    .Execute
  End With
  Do While .Find.Found
    Set Rng = .Paragraphs(1).Range
    Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
    Set DocTgt = Documents.Add(DocSrc.AttachedTemplate.FullName)
    With DocTgt
    Application.ScreenUpdating = False
      .Range.FormattedText = Rng.FormattedText
      StrTxt = Split(.Paragraphs.First.Range.Text, vbCr)(0)
      ' Strip out illegal characters
      For i = 1 To Len(StrNoChr)
        StrTxt = Replace(StrTxt, Mid(StrNoChr, i, 1), "_")
      Next
      .Paragraphs.First.Range.Delete
      .SaveAs2 FileName:=DocSrc.Path & "\" & StrTxt & ".rtf", Fileformat:=wdFormatRTF, AddToRecentFiles:=False
      .Close False
    End With
    .Start = Rng.End
    .Find.Execute
  Loop
End With
Set Rng = Nothing: Set DocSrc = Nothing: Set DocTgt = Nothing
Application.ScreenUpdating = True
End Sub

Welcome to Stack Overflow. Are you sure that all that is necessary for the question? — ashleedawg
@ashleedawg Haha, very true. Well, in many questions from beginners commenters ask for the full code, so he just did it right away ;) — Roemer
@Roemer That's a lot more than code and someone's bound to get offended. This is about splitting at the headings, correct? — ashleedawg
I've edited it to remove the lengthy unnecessary text. I think it's also important to remember Stack Overflow consists of users from all over the world, with many different backgrounds. Let's try to keep things neutral. — ashleedawg
I did not know that a small quote from a dictionary would cause a problem for anyone. And yes as noted above the first time I posted an example like the one you have edited, I was told to expand it.... Anyway it was only my second question. — JPG

JPG JPG · Accepted Answer · 2018-03-31T15:11:42

To stop Word opening another window that flashes each time the macro makes a new document, just add this code indicated at these places ##########

Sub SplitDocOnHeading1ToRtfWithoutHeadingInOutput()
'Splits the document on Heading1 style, into new documents, Heading1 is NOT included in the data
'but becomes the file name.
With Word.Application '##########
    .Visible = False '##########

Application.ScreenUpdating = False
Dim rng As Range, DocSrc As Document, DocTgt As Document
Dim i As Long, StrTxt As String: Const StrNoChr As String = """*/\:?|"
Set DocSrc = ActiveDocument
With DocSrc.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Format = True
    .Forward = True
    .Text = ""
    .Style = wdStyleHeading1
    .Replacement.Text = ""
    .Wrap = wdFindStop
    .Execute
  End With
  Do While .Find.Found
    Set rng = .Paragraphs(1).Range
    Set rng = rng.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
    Set DocTgt = Documents.Add(DocSrc.AttachedTemplate.FullName)
    With DocTgt
    Application.ScreenUpdating = False
      .Range.FormattedText = rng.FormattedText
      StrTxt = Split(.Paragraphs.First.Range.Text, vbCr)(0)
      ' Strip out illegal characters
      For i = 1 To Len(StrNoChr)
        StrTxt = Replace(StrTxt, Mid(StrNoChr, i, 1), "_")
      Next
      .Paragraphs.First.Range.Delete 'comment out this line if you want to retain headings in the output file
      .SaveAs2 FileName:=DocSrc.Path & "\" & StrTxt & ".rtf", Fileformat:=wdFormatRTF, AddToRecentFiles:=False
      .Close False
    End With
    .Start = rng.End
    .Find.Execute
  Loop
End With
Set rng = Nothing: Set DocSrc = Nothing: Set DocTgt = Nothing
Application.ScreenUpdating = True
         .Visible = True '##########
        End With '##########
End Sub

Is there a way to run this macro in Word, without Word opening other windows and flashing

3 Answers