Microsoft Office Forums - View Single Post - [Solved] Creating Macro: I don't seem to be able to achieve this

macropod · 10-19-2025, 04:09 PM

Here's a macro I recorded. Frankly, I can't see the point of demonstrating that you can record macros...

Code:

Sub Macro1()
'
' Macro1 Macro
'
'
  Selection.EndKey Unit:=wdStory
  Selection.Font.Bold = wdToggle
  Selection.Font.Size = 18
  Selection.Font.Underline = wdUnderlineSingle
  Selection.Font.UnderlineColor = wdColorAutomatic
  Selection.TypeText Text:="WEEKLY MENU"
  Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
  Selection.EndKey Unit:=wdStory
  Selection.TypeParagraph
  Selection.TypeParagraph
  Selection.TypeParagraph
  ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=3, NumColumns:= _
    8, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
    wdAutoFitFixed
  With Selection.Tables(1)
    If .Style <> "Table Grid" Then
      .Style = "Table Grid"
    End If
    .ApplyStyleHeadingRows = True
    .ApplyStyleLastRow = False
    .ApplyStyleFirstColumn = True
    .ApplyStyleLastColumn = False
    .ApplyStyleRowBands = True
    .ApplyStyleColumnBands = False
  End With
  Selection.EscapeKey
  Selection.Tables(1).Style = "Grid Table 5 Dark - Accent 6"
  Selection.Tables(1).Select
  Selection.Font.Bold = wdToggle
  Selection.Font.Size = 10
  Selection.HomeKey Unit:=wdLine
  Selection.MoveRight Unit:=wdCharacter, Count:=8, Extend:=wdExtend
  Selection.Font.Bold = wdToggle
  Selection.Font.UnderlineColor = wdColorAutomatic
  Selection.Font.Underline = wdUnderlineNone
  Selection.MoveLeft Unit:=wdCharacter, Count:=1
  Selection.MoveRight Unit:=wdCharacter, Count:=1
  Selection.MoveRight Unit:=wdCharacter, Count:=7, Extend:=wdExtend
  Selection.Font.UnderlineColor = wdColorAutomatic
  Selection.Font.Underline = wdUnderlineSingle
  Selection.TypeText Text:="Mon"
  Selection.MoveRight Unit:=wdCharacter, Count:=1
  Selection.TypeText Text:="Tues"
  Selection.MoveRight Unit:=wdCharacter, Count:=1
  Selection.TypeText Text:="Wed"
  Selection.MoveRight Unit:=wdCharacter, Count:=1
  Selection.TypeText Text:="Thurs"
  Selection.MoveRight Unit:=wdCharacter, Count:=1
  Selection.TypeText Text:="Fri"
  Selection.MoveRight Unit:=wdCharacter, Count:=1
  Selection.TypeText Text:="Sat"
  Selection.MoveRight Unit:=wdCharacter, Count:=1
  Selection.TypeText Text:="Sun"
  Selection.MoveRight Unit:=wdCharacter, Count:=2
  Selection.TypeText Text:="LUNCH"
  Selection.MoveDown Unit:=wdLine, Count:=1
  Selection.TypeText Text:="DINNER"
  Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
  Selection.Font.UnderlineColor = wdColorAutomatic
  Selection.Font.Underline = wdUnderlineNone
End Sub