[Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 463
  • Last Modified:

VBA loop code adding an extra slide

I have written some VBA code to create an agenda in powerpoint based on the entries of a user form. I have coded a loop to format the agenda, and that is all working fine, but it keeps adding a slide at the end of the Agenda. So, I put in a line to delete that slide, but the line doesn't always work - sometimes it does and sometimes it gives me an error message. I think I've gone wrong somewhere in the loop but I'm not sure where? I've pasted the code below (stripped out the irrelevant formatting).

Set s_ag = ppt.Slides.AddSlide(ActiveWindow.Selection.SlideRange.SlideIndex + 1, Agenda_layout)

        'Title
        s_ag.Shapes.Title.TextFrame.TextRange.Text = "Agenda"

        'Agenda text box
        Set Ag_text = s_ag.Shapes.AddTextbox(msoTextOrientationHorizontal, 157.8898, 134.9291, 422.9291, 100)
            Ag_text.TextFrame.TextRange.Font.Color.RGB = RGB(57, 50, 43)
                    Ag_text.TextFrame.TextRange.Text = Ag_tx1 & vbNewLine & Ag_tx2 & vbNewLine & Ag_tx3 & vbNewLine & Ag_tx4 _
                            & vbNewLine & Ag_tx5 & vbNewLine & Ag_tx6 & vbNewLine & Ag_tx7 & vbNewLine & Ag_tx8
                    If Ag_tx8.Text = "" Then
                    Ag_text.TextFrame.TextRange.Text = Ag_tx1 & vbNewLine & Ag_tx2 & vbNewLine & Ag_tx3 & vbNewLine & Ag_tx4 _
                            & vbNewLine & Ag_tx5 & vbNewLine & Ag_tx6 & vbNewLine & Ag_tx7
                    End If
                    If Ag_tx7.Text = "" Then
                        Ag_text.TextFrame.TextRange.Text = Ag_tx1 & vbNewLine & Ag_tx2 & vbNewLine & Ag_tx3 & vbNewLine & Ag_tx4 _
                            & vbNewLine & Ag_tx5 & vbNewLine & Ag_tx6
                    End If
                    If Ag_tx6.Text = "" Then
                        Ag_text.TextFrame.TextRange.Text = Ag_tx1 & vbNewLine & Ag_tx2 & vbNewLine & Ag_tx3 & vbNewLine & Ag_tx4 _
                            & vbNewLine & Ag_tx5
                    End If
                    If Ag_tx5.Text = "" Then
                        Ag_text.TextFrame.TextRange.Text = Ag_tx1 & vbNewLine & Ag_tx2 & vbNewLine & Ag_tx3 & vbNewLine & Ag_tx4
                    End If
                    If Ag_tx4.Text = "" Then
                        Ag_text.TextFrame.TextRange.Text = Ag_tx1 & vbNewLine & Ag_tx2 & vbNewLine & Ag_tx3
                    End If
                    If Ag_tx3.Text = "" Then
                        Ag_text.TextFrame.TextRange.Text = Ag_tx1 & vbNewLine & Ag_tx2
                    End If
                    If Ag_tx2.Text = "" Then
                        Ag_text.TextFrame.TextRange.Text = Ag_tx1
                    End If

            'Agenda rhombus (marker for each point)
            Set Ag_shp = s_ag.Shapes.AddShape(msoShapeRectangle, 96.37795, 546.5198, 28.34646, 28.34646)
                Ag_shp.IncrementRotation (45)
                    If Ag_tx8.Text = "" Then
                        Ag_shp.Top = 494.6457
                    End If
                    If Ag_tx7.Text = "" Then
                        Ag_shp.Top = 442.7717
                    End If
                    If Ag_tx6.Text = "" Then
                        Ag_shp.Top = 390.8977
                    End If
                    If Ag_tx5.Text = "" Then
                        Ag_shp.Top = 339.0237
                    End If
                    If Ag_tx4.Text = "" Then
                        Ag_shp.Top = 287.1497
                    End If
                    If Ag_tx3.Text = "" Then
                        Ag_shp.Top = 235.37795
                    End If
                    If Ag_tx2.Text = "" Then
                        Ag_shp.Top = 183.4016
                    End If


End If
Next

ActiveWindow.View.GotoSlide (ActiveWindow.Selection.SlideRange.SlideIndex + 1)

Set scurrent = ppt.Slides(ActiveWindow.Selection.SlideRange.SlideIndex)
Set Ag_textcurrent = Ag_text
  paracount = Ag_textcurrent.TextFrame.TextRange.Paragraphs.Count
    For x = paracount To 1 Step -1
        Set snew = scurrent.Duplicate(1)
            With Ag_shp
                .IncrementTop -51.87402
            End With
            Set Ag_textnew = Ag_textcurrent
            With Ag_textnew
                .TextFrame.TextRange.Paragraphs(x).Font.Bold = msoTrue
                .TextFrame.TextRange.Paragraphs(x + 1).Font.Bold = msoFalse
                .TextFrame.TextRange.Paragraphs(x).Font.Color.RGB = RGB(153, 0, 51)
                .TextFrame.TextRange.Paragraphs(x + 1).Font.Color.RGB = RGB(57, 50, 43)
            End With

    Next x

ActiveWindow.View.GotoSlide (ActiveWindow.Selection.SlideRange.SlideIndex + paracount)
ActiveWindow.Selection.Delete
0
jessica2013
Asked:
jessica2013
1 Solution
 
JSRWilsonCommented:
You might do better to explain exactly what you have on the form and what you want to get as the outcome. Some of the logic is your code is almost certainly a lot more complex than it needs to be.

It looks like the extra slide would be set to the object var snew in which case you should be able to say snew.Delete to delete the extra slide
0

Featured Post

[Webinar] Cloud and Mobile-First Strategy

Maybe you’ve fully adopted the cloud since the beginning. Or maybe you started with on-prem resources but are pursuing a “cloud and mobile first” strategy. Getting to that end state has its challenges. Discover how to build out a 100% cloud and mobile IT strategy in this webinar.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now