A different type of Macro, for Word

Convert exported OneNote headings into Word headings

August 29, 2013

Taking a break from Onetastic macros, today I have a Word macro to share that will convert headings that are imported from OneNote into Word headings. If you had a page in OneNote that used heading styles, and then either copy pasted them into Word or used the File > Send > Send to Word feature, your headings will have the right formatting in Word but they wont have the heading style (e.g. they won't be recognized as headers).

I wrote a VBA macro in Word to convert them into headings by looking at their formatting (font size, color, bold, italic) and applying the right formatting. You can just import this in Word by:

  1. Hit Alt+F11 to open VBA editor
  2. Double click on ThisDocument on the left
  3. Paste it
  4. Hit F5 to run the macro
  5. If it asks which macro to run, choose ConvertHeadings

This uses the formatting of OneNote 2010. Fonts and colors would be different in OneNote 2013, so those need to be updated in the script to work in OneNote 2013. Here is the full VBA script. Enjoy!

Private Type Heading
    Size As Integer
    Bold As Boolean
    Italic As Boolean
    Color As WdColor
End Type
    
Sub ConvertHeadings()
    Dim headings(1 To 6) As Heading
    
    With headings(1)
        .Size = 16
        .Bold = True
        .Italic = False
        .Color = &H5D3617
    End With
    
    With headings(2)
        .Size = 13
        .Bold = True
        .Italic = False
        .Color = &H926036
    End With
    
    With headings(3)
        .Size = 11
        .Bold = True
        .Italic = False
        .Color = &H926036
    End With
    
    With headings(4)
        .Size = 11
        .Bold = True
        .Italic = True
        .Color = &H926036
    End With
    
    With headings(5)
        .Size = 11
        .Bold = False
        .Italic = False
        .Color = &H926036
    End With
    
    With headings(6)
        .Size = 11
        .Bold = False
        .Italic = True
        .Color = &H926036
    End With
    
    For i = 1 To 6
        Selection.Find.ClearFormatting
        With Selection.Find
            .Font.Name = "Calibri"
            .Font.Size = headings(i).Size
            .Font.Bold = headings(i).Bold
            .Font.Italic = headings(i).Italic
            .Font.Color = headings(i).Color
            .Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Replacement.Text = ""
            .Replacement.ClearFormatting
            .Replacement.Style = ActiveDocument.Styles("Heading " + CStr(i))
            .Replacement.Font.Name = "Calibri"
            .Replacement.Font.Size = headings(i).Size
            .Replacement.Font.Bold = headings(i).Bold
            .Replacement.Font.Italic = headings(i).Italic
            .Replacement.Font.Color = headings(i).Color
            .Execute Replace:=wdReplaceAll
        End With
                
        Selection.EscapeKey
    Next
End Sub

Comments

Name
Comment
Ashley Silver - 2016-03-31
This is a helpful link, but you can waste a lot of time.
I converted the above to work with Office 2013 (including Calibri Light for tab headings), but it only works if styles "Heading 1", "Heading 2... Heading 6 are available in the current Word document.

Another problem is removing the Dates and Times under the headings.  For this I used:

Sub RemoveDates()

    Selection.Find.ClearFormatting
    With Selection.Find
        .Font.Name = "Calibri"
        .Font.Size = 10
        .Font.Bold = False
        .Font.Italic = False
        .Font.Color = RGB(128, 128, 128)
        .Text = "(<*,*,*>)?*?:?? ?M?"
        .Replacement.Text = "^l"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

End Sub
oz2007 - 2016-03-11
Dear all,

This macro is very usefull but I could not make it work.
I have the error 5941. Any idea why? (I have pasted the macro on ThisDocument as explained).
I have the 2016 version so I tried the GeoffE'code.

Thank you,
Regards
Vanessa
GeoffE - 2016-01-21
Thanks for put this in Onetastic your name says it all.

Other Posts

Show all posts