Month appears in the slide heading's placeholder by accident

[StarPig]

Hi VBA Express

I have the below code, but when I run it on the attached slide, the month and year appears in the placeholder (heading) of the slide, even replacing any heading that was there.

Is there a way so the month and year only stay within the table?

Thank you

Sub Calendar()
Dim strText As String
Dim osld As Slide
Set osld = ActiveWindow.Selection.SlideRange(1)
With osld.Shapes.AddTable(7, 7)
    With .Table.Cell(1, 1)
        With .Borders(ppBorderTop)
            .visible = True
            .Weight = 1
            .ForeColor.RGB = RGB(0, 0, 0)
            .DashStyle = msoLineSolid
       End With
   End With
.Width = 500
.Left = 50
.Top = 150
Dim shp As Shape
For Each shp In ActiveWindow.Selection.SlideRange.Shapes
    With shp
        If .HasTable Then .Select
   End With
Next shp
With ActiveWindow.Selection.ShapeRange(1).Table
    With .Cell(1, 1).Shape
        With .TextFrame2.TextRange
            .Text = "Mon"
        End With
    End With
End With
With ActiveWindow.Selection.ShapeRange(1).Table
    With .Cell(1, 2).Shape
        With .TextFrame2.TextRange
            .Text = "Tue"
        End With
    End With
End With
With ActiveWindow.Selection.ShapeRange(1).Table
    With .Cell(1, 3).Shape
        With .TextFrame2.TextRange
            .Text = "Wed"
        End With
    End With
End With
With ActiveWindow.Selection.ShapeRange(1).Table
    With .Cell(1, 4).Shape
        With .TextFrame2.TextRange
            .Text = "Thu"
        End With
    End With
End With
With ActiveWindow.Selection.ShapeRange(1).Table
    With .Cell(1, 5).Shape
        With .TextFrame2.TextRange
            .Text = "Fri"
        End With
    End With
End With
With ActiveWindow.Selection.ShapeRange(1).Table
    With .Cell(1, 6).Shape
        With .TextFrame2.TextRange
            .Text = "Sat"
        End With
    End With
End With
With ActiveWindow.Selection.ShapeRange(1).Table
    With .Cell(1, 7).Shape
        With .TextFrame2.TextRange
            .Text = "Sun"
        End With
    End With
End With
Dim lngY As Long
Dim lngM As Long
Dim firstDay As Long
Dim lngDayCNT As Long
Dim lastDay As Long
Dim lngDay As Long
Dim lngCount As Long
Dim x As Long
Dim L As Long
Dim LR As Long
Dim LC As Long
Dim rayDays(1 To 42) As String
Const StartDay As Long = vbMonday
On Error Resume Next
Set otbl = ActiveWindow.Selection.ShapeRange(1).Table
If otbl Is Nothing Then
    MsgBox "Select a table", vbCritical
    Exit Sub
End If
lngY = InputBox("Enter Year")
If Not IsNumeric(lngY) Then Exit Sub
    lngM = InputBox("Enter Month Number (e.g. 1 = Jan, 2 = Feb... 12 = Dec")
        If Not IsNumeric(lngM) Then Exit Sub
            If lngM < 1 Or lngM > 12 Then Exit Sub
                firstDay = Weekday(DateSerial(lngY, lngM, 1), StartDay)
                lngDayCNT = Day(DateSerial(lngY, lngM + 1, 1) - 1)
                lastDay = lngDayCNT + firstDay - 1
                   For L = firstDay To lastDay
                       lngDay = lngDay + 1
                       rayDays(L) = lngDay
                  Next L
                  For LR = 2 To 7
                      For LC = 1 To 7
                          x = x + 1
                          otbl.Cell(LR, LC).Shape.TextFrame.TextRange = CStr(rayDays(x))
                          otbl.Cell(LR, LC).Shape.TextFrame.TextRange.Font.Size = 12
                      Next
                  Next
                  Set osld = ActiveWindow.Selection.SlideRange(1)
                  osld.Shapes.title.TextFrame.TextRange = MonthName(lngM) & " " & lngY
                  Dim B As Long
                  Set otbl = ActiveWindow.Selection.ShapeRange(1).Table
                  otbl.Parent.Height = 0
                  For x = 1 To otbl.Columns.Count
                      For Y = 1 To otbl.Rows.Count
                         With otbl.Cell(Y, x)
                             .Shape.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
                             .Shape.TextFrame2.TextRange.Font.Size = 12
                             .Shape.TextFrame2.TextRange.Font.Name = "Arial"
                             .Shape.TextFrame2.HorizontalAnchor = msoAnchorCenter
                             .Shape.Fill.ForeColor.RGB = RGB(0, 0, 0)
                             Select Case Y
                             Case Is = 1
                                .Shape.TextFrame2.MarginLeft = 0
                                .Shape.TextFrame2.MarginRight = 0
                                .Shape.TextFrame2.TextRange.Font.Bold = msoTrue
                                .Shape.TextFrame2.VerticalAnchor = msoAnchorMiddle
                                .Shape.TextFrame2.HorizontalAnchor = msoAnchorCenter
                                .Shape.Fill.ForeColor.RGB = RGB(170, 170, 170)
                           Case Is = 2
                               .Shape.TextFrame2.MarginLeft = 5
                               .Shape.TextFrame2.MarginRight = 5
                               .Shape.TextFrame2.TextRange.Font.Bold = msoFalse
                               .Shape.TextFrame2.VerticalAnchor = msoAnchorMiddle
                               .Shape.Fill.ForeColor.RGB = RGB(225, 225, 225)
                           Case Else
                               .Shape.TextFrame2.MarginLeft = 5
                               .Shape.TextFrame2.MarginRight = 5
                               .Shape.TextFrame2.TextRange.Font.Bold = msoFalse
                               .Shape.TextFrame2.VerticalAnchor = msoAnchorMiddle
                               .Shape.Fill.ForeColor.RGB = RGB(225, 225, 225)
                          End Select
                     End With
                Next 'y
           Next 'x
           With ActiveWindow.Selection.ShapeRange(1).Table
               With .Cell(1, 1).Shape
                   With .TextFrame2.TextRange
                   End With
               End With
          End With
          With ActiveWindow.Selection.ShapeRange(1).Table
               With .Cell(1, 1).Shape
                   With .TextFrame2.TextRange
                   End With
               End With
          End With
     End With
     ActiveWindow.Selection.ShapeRange(1).Table.Rows.Add 1
     With ActiveWindow.Selection.ShapeRange(1).Table
        With .Cell(1, 1).Shape
            With .TextFrame2.TextRange
                .Text = MonthName(lngM) & " " & lngY
            End With
        End With
   End With
  With ActiveWindow.Selection.ShapeRange(1).Table
       .Cell(row:=1, Column:=1).Merge _
        MergeTo:=.Cell(row:=1, Column:=7)
   End With
End Sub