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

[June7]

I downloaded your file. Didn't find any code. Had to add module and save as pptm. There were two variables not declared: otbl and Y. Do you have Option Explicit at top of module?

The date gets added to title with this line:
osld.Shapes.Title.TextFrame.TextRange = MonthName(lngM) & " " & lngY

What do you want instead?

[StarPig]

Hi June7

Thanks for replying - I've attached the *.pptm file, sorry I sent the *.pptx

Basically, when it inserts the calendar month, I don't want it to change the slide heading's placeholder - even if there's text typed in, it overwrites it with the calendar table's month and year.

I'm amateur, and sorry, I don't now what "Do you have Option Explicit at top of module?" means.

Thank you

[Aussiebear]

If you have Option Explicit at the top of your code, it forces you to define your variables, and then helps correct your code.

[June7]

Either modify the line I indicated to set box to something else or delete it or comment it so it does not execute. Your choice.

Review http://fmsinc.com/MicrosoftAccess/mo...20be%20Checked

[StarPig]

Hi June7, I did both ways, deleted the line, but it still replaced the slide's main heading with the month and year from the table's heading. I went into the Visual Basic Editor and in the tools menu clicked options, editor tab and ticked “Require Variable Declaration”. Unfortunately the heading still drops into the placeholder.
Any suggestion please on the code? I'm not an expert, self-taught, but maybe another code is overwriting your cool suggestions, so the table heading's month/year is repeating in the slide placeholder heading? Thank you, and sorry to be a pain. Best regards, Ray

[John Wilson]

This line is doing what you asked it to! (Adding the date to the Slide Title.)

 osld.Shapes.title.TextFrame.TextRange = MonthName(lngM) & " " & lngY

[June7]

Hi June7, I did both ways, deleted the line, but it still replaced the slide's main heading with the month and year from the table's heading. I went into the Visual Basic Editor and in the tools menu clicked options, editor tab and ticked “Require Variable Declaration”. Unfortunately the heading still drops into the placeholder.
Any suggestion please on the code? I'm not an expert, self-taught, but maybe another code is overwriting your cool suggestions, so the table heading's month/year is repeating in the slide placeholder heading? Thank you, and sorry to be a pain. Best regards, Ray

I commented line and Slide Title box no longer gets date. Deleting line should produce same result. As far as I can tell, there is nothing else causing box to get date.

Just setting "Require Variable Declaration" box will not add Option Explicit line to existing module. You will have to manually add by typing.

[StarPig]

Thanks John, I delete it and it still appears as the slide title... I wish it didn't appear at the top of my slide. If there's no placeholder, it doesn't appear. Sorry to be bad at explaining.

[June7]

Did you save the code and the pptm document after edit?

[StarPig]

Hi John and June7, THANK YOU!!! I needed to save the pptm after editing - d'oh. So embarrassing!
THANKS A MILLION - I only wish I'd asked for help sooner, I've spent hours / days trying to fix it . Thanks!

[June7]

Don't feel so bad. I did the same thing, probably because I didn't expect to visit it again. But then I did and when I reopened the pptm, code was as it was before.

[John Wilson]

Glad it worked out. I originally wrote the code for a client and in that the Month / Year was supposed to end up in the slide title. Someone has hacked the code around a lot so here is the original for you.

Sub Calendar()
Dim strText As String
Dim osld As Slide
Dim oshp As Shape
Dim otbl As Table
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 dayName() As String
Set osld = ActiveWindow.Selection.SlideRange(1)
Set oshp = osld.Shapes.AddTable(7, 7)
Set otbl = oshp.Table
   With oshp
.Width = 500
.Left = 50
.Top = 150
End With
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
With otbl
        With .Cell(1, 1).Shape
            With .TextFrame2.TextRange
                .Text = MonthName(lngM) & " " & lngY
            End With
        End With
   End With
  With otbl
       .Cell(Row:=1, Column:=1).Merge _
        MergeTo:=.Cell(Row:=1, Column:=7)
   End With
dayName = Split("Mon/Tue/Wed/Thu/Fri/Sat/Sun", "/")
For LC = 1 To 7
otbl.Cell(2, LC).Shape.TextFrame.TextRange = dayName(LC - 1)
Next LC
Dim rayDays(1 To 42) As String
Const StartDay As Long = vbMonday
On Error Resume Next
                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 8
                      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
                  For LR = 1 To otbl.Columns.Count
                      For LC = 1 To otbl.Rows.Count
                         With otbl.Cell(LR, LC).Shape.TextFrame2
                             .TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
                             .TextRange.Font.Size = 12
                             .TextRange.Font.Name = "Arial"
                             .HorizontalAnchor = msoAnchorCenter
                             Select Case LR
                             Case Is = 1
                                .MarginLeft = 0
                                .MarginRight = 0
                                .TextRange.Font.Bold = msoTrue
                                .VerticalAnchor = msoAnchorMiddle
                                .HorizontalAnchor = msoAnchorCenter
                                otbl.Cell(LR, LC).Shape.Fill.ForeColor.RGB = RGB(170, 170, 170)
                           Case Else
                               .MarginLeft = 5
                               .MarginRight = 5
                               .TextRange.Font.Bold = msoFalse
                               .VerticalAnchor = msoAnchorMiddle
                               otbl.Cell(LR, LC).Shape.Fill.ForeColor.RGB = RGB(225, 225, 225)
                          End Select
                     End With
                Next LC
           Next LR
     If Not otbl.Cell(7, 1).Shape.TextFrame2.HasText Then
     otbl.Rows(7).Delete
     End If
End Sub

[StarPig]

Thank you