Solved

VBA loop code adding an extra slide

Posted on 2013-11-21
1
439 Views
Last Modified: 2013-11-22
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
Comment
Question by:jessica2013
1 Comment
 
LVL 23

Accepted Solution

by:
JSRWilson earned 500 total points
Comment Utility
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

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…

772 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now