Consulting

Results 1 to 14 of 14

Thread: Month appears in the slide heading's placeholder by accident

  1. #1
    VBAX Regular
    Joined
    Dec 2018
    Posts
    20
    Location

    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

    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
    Attached Files Attached Files

  2. #2
    VBAX Regular
    Joined
    Nov 2022
    Location
    The Great Land
    Posts
    57
    Location
    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?
    How to attach file: How to upload your attachments (vbaexpress.com) To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  3. #3
    VBAX Regular
    Joined
    Dec 2018
    Posts
    20
    Location
    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
    Attached Files Attached Files

  4. #4
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    4,286
    Location
    If you have Option Explicit at the top of your code, it forces you to define your variables, and then helps correct your code.
    Remember To Do the Following....
    Use tags when posting code to the thread,
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  5. #5
    VBAX Regular
    Joined
    Nov 2022
    Location
    The Great Land
    Posts
    57
    Location
    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
    How to attach file: How to upload your attachments (vbaexpress.com) To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  6. #6
    VBAX Regular
    Joined
    Dec 2018
    Posts
    20
    Location
    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

  7. #7
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,064
    Location
    This line is doing what you asked it to! (Adding the date to the Slide Title.)

     osld.Shapes.title.TextFrame.TextRange = MonthName(lngM) & " " & lngY
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  8. #8
    VBAX Regular
    Joined
    Nov 2022
    Location
    The Great Land
    Posts
    57
    Location
    Quote Originally Posted by StarPig View Post
    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.
    How to attach file: How to upload your attachments (vbaexpress.com) To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  9. #9
    VBAX Regular
    Joined
    Dec 2018
    Posts
    20
    Location
    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.

  10. #10
    VBAX Regular
    Joined
    Nov 2022
    Location
    The Great Land
    Posts
    57
    Location
    Did you save the code and the pptm document after edit?
    How to attach file: How to upload your attachments (vbaexpress.com) To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  11. #11
    VBAX Regular
    Joined
    Dec 2018
    Posts
    20
    Location
    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!

  12. #12
    VBAX Regular
    Joined
    Nov 2022
    Location
    The Great Land
    Posts
    57
    Location
    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.
    How to attach file: How to upload your attachments (vbaexpress.com) To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

  13. #13
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,064
    Location
    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
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  14. #14
    VBAX Regular
    Joined
    Dec 2018
    Posts
    20
    Location
    Thank you

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •