How can I condense this code? (1 Viewer)

[fkneg1]

I have the following bit of code repeated lots of times in my code to make powerpoint slides based on each field of a query with only one line changing each time. Any ideas how I can condense it because my code is too big?

                        With .Slides.Add(rs.AbsolutePosition + 1, ppLayoutLargeObject)
                        .FollowMasterBackground = False
                        .Background.Fill.Solid
                        .Background.Fill.ForeColor.RGB = RGB(0, 0, 0)
                            With .Shapes(1).TextFrame.TextRange
                            
'--------------------The line below is the only one that changes each time
                                 .Text = CStr(rs.Fields("Song 1 chosen_Verse 1").Value)
                                 
                                 .Characters.Font.Color.RGB = RGB(255, 255, 255)
                                 .Characters.Font.Size = 36
                                 .ParagraphFormat.Bullet = False
                                 .ParagraphFormat.Alignment = ppAlignCenter
                            End With
                        End With

I was thinking of using other sub's with call commands???

 

[CJ_London]

You should be able to use a loop - such as for each, do while, while not, for i=1 to 10 etc e.g.

[COLOR=red]while not rs.eof[/COLOR]
With .Slides.Add(rs.AbsolutePosition + 1, ppLayoutLargeObject)
                        .FollowMasterBackground = False
                        .Background.Fill.Solid
                        .Background.Fill.ForeColor.RGB = RGB(0, 0, 0)
                            With .Shapes(1).TextFrame.TextRange
 
'--------------------The line below is the only one that changes each time
                                 .Text = CStr(rs.Fields("Song 1 chosen_Verse 1").Value)
 
                                 .Characters.Font.Color.RGB = RGB(255, 255, 255)
                                 .Characters.Font.Size = 36
                                 .ParagraphFormat.Bullet = False
                                 .ParagraphFormat.Alignment = ppAlignCenter
                            End With
                        End With
    [COLOR=red]rs.movenext[/COLOR]
[COLOR=red]wend[/COLOR]

 

[Pat Hartman]

You need some place to get the value you want to replace ("Song 1 chosen_Verse 1") with. That's the recordset CJ is referring to.

 

[fkneg1]

CJ - what you have written is exactly what I have already got - I should have explained it better. The problem is that because the records I need on each slide are located in different fields it won't automatically loop for each one so I have to write the code out with that one line different so that it links to the next field like this:

with ppPres
       while not rs.eof
                    If IsNull(rs.Fields("Song 1 chosen_Verse 3").Value) Then
                    Else
                        With .Slides.Add(rs.AbsolutePosition + 1, ppLayoutLargeObject)
                        .FollowMasterBackground = False
                        .Background.Fill.Solid
                        .Background.Fill.ForeColor.RGB = RGB(0, 0, 0)
                            With .Shapes(1).TextFrame.TextRange
                                 .Text = CStr(rs.Fields("Song 1 chosen_Verse 3").Value)
                                 .Characters.Font.Color.RGB = RGB(255, 255, 255)
                                 .Characters.Font.Size = 36
                                 .ParagraphFormat.Bullet = False
                                 .ParagraphFormat.Alignment = ppAlignCenter
                            End With
                        End With
                    End If
'-----------song 1 verse 2 if present----------
                    If IsNull(rs.Fields("Song 3 chosen_Verse 2").Value) Then
                    Else
                        With .Slides.Add(rs.AbsolutePosition + 1, ppLayoutLargeObject)
                        .FollowMasterBackground = False
                        .Background.Fill.Solid
                        .Background.Fill.ForeColor.RGB = RGB(0, 0, 0)
                            With .Shapes(1).TextFrame.TextRange
                                 .Text = CStr(rs.Fields("Song 1 chosen_Verse 2").Value)
                                 .Characters.Font.Color.RGB = RGB(255, 255, 255)
                                 .Characters.Font.Size = 36
                                 .ParagraphFormat.Bullet = False
                                 .ParagraphFormat.Alignment = ppAlignCenter
                            End With
                        End With
                    End If
            rs.movenext
       wend

As you can see I have to repeat the code quite a lot - there are lots more slides the same but all referring to a different field. Any ideas??

 

[pr2-eugin]

This problem I guess is because the data is structured incorrectly.. The table you have is something like..

tblSongs
songID
songName
lyricsVerse1
lyricsVerse2
lyricsVerse3
:
lyricsVerseN

If your Data is in the above structure, you will have hard time with getting the data.. What you should have is..

tblSongList
songID (Primary Key)
songName
songComposer

tblLyrics
lyricID (Primary Key)
songID_FK (Foreign Key)
lyricsOfSong

So instead of your Data being..

songID        songName        lyricsVerse1        lyricsVerse2        lyricsVerse3
1            Coming Home      I’m coming home     I’m coming home     Tell the World I’m coming home

It should actually be,

songID        songComposer    songName  
1            Diddy            Coming Home

lyricID     songID_FK         lyricsOfSong
1            1                I’m coming home
2            1                I’m coming home
3            1                Tell the World I’m coming home

 

[nanscombe]

I would try and make the repetitive bit into a sub routine and pass the verse as a string. I would also move the PPres declaration into the main declaration area so it was available throughout.

*** This code is off the top of my head and is incomplete but may give you a few ideas.

Option Compare Database
Option Explicit

Dim PPres as ????

Private Sub addSlides()
Dim rs as Recordset
Dim intVerse as Integer, intVerseMax as Integer

' Set rs = ....
' Set PPres = ...
' ...

  while not rs.eof

    For intVerse = 1 to intVerseMax

      addSlide rs.Fields("Song 3 chosen_Verse " & intVerse) & vbNullString, rs.AbsolutePosition + 1

    Next intVerse

    rs.movenext

  Wend

' ...
' rs.Close
' Set rs = Nothing

' Set PPres = Nothing
End Sub

Private Sub addSlide(byval theVerse as String, byval thePosition as Long)
  If Len(theVerse & vbNullString) = 0 Then Exit Sub

  With PPres

    With .Slides.Add(thePosition, ppLayoutLargeObject)

      .FollowMasterBackground = False
      .Background.Fill.Solid
      .Background.Fill.ForeColor.RGB = RGB(0, 0, 0)

      With .Shapes(1).TextFrame.TextRange

        .Text = theVerse
        .Characters.Font.Color.RGB = RGB(255, 255, 255)
        .Characters.Font.Size = 36
        .ParagraphFormat.Bullet = False
        .ParagraphFormat.Alignment = ppAlignCenter

      End With

    End With

  End With

End Sub

A bit of fiddling might be needed with the addSlide line as it would be trying to add to the same place, an incrementing counter perhaps?

Private Sub addSlides()
Dim rs as Recordset
Dim intVerse as Integer, intVerseMax as Integer, intSlide as Integer

' Set rs = ....
' Set PPres = ...
' ...

  intSlide = 1

  while not rs.eof

    For intVerse = 1 to intVerseMax

      addSlide rs.Fields("Song 3 chosen_Verse " & intVerse) & vbNullString, intSlide

      intSlide = intSlide +1

    Next intVerse

    rs.movenext

  Wend

' ...
' rs.Close
' Set rs = Nothing

' Set PPres = Nothing
End Sub

 

[fkneg1]

Thanks for your help. I have managed to get it doing what I want using what you said. It now looks like this which does the job:

For intVerse = 16 To 1 Step -1
        If IsNull(rs.Fields("Song 1 chosen_Verse " & intVerse).Value) Then
            Else
                With .Slides.Add(rs.AbsolutePosition + 1, ppLayoutLargeObject)
                     .FollowMasterBackground = False
                     .Background.Fill.Solid
                     .Background.Fill.ForeColor.RGB = RGB(0, 0, 0)
                    With .Shapes(1).TextFrame.TextRange
                         .Text = CStr(rs.Fields("Song 1 chosen_Verse " & intVerse).Value)
                         .Characters.Font.Color.RGB = RGB(255, 255, 255)
                         .Characters.Font.Size = 36
                         .ParagraphFormat.Bullet = False
                         .ParagraphFormat.Alignment = ppAlignCenter
                    End With
                End With
       End If
Next intVerse