Month appears in the slide heading's placeholder by accident

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 :)

Code:

---


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

---

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?

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 :)

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

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

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

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

Code:

---

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

---

Quote:

---

Originally Posted by 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

---

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.

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.

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

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

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.

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.

Code:

---

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

---

Thank you :)