Powerpoint Macro Help

%3CLINGO-SUB%20id%3D%22lingo-sub-2464075%22%20slang%3D%22en-US%22%3EPowerpoint%20Macro%20Help%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-2464075%22%20slang%3D%22en-US%22%3E%3CP%3EHello%20all!%26nbsp%3B%20I%20am%20working%20with%20a%20macro%20that%20will%20pull%20data%20from%20an%20active%20Excel%20sheet%20and%20create%20slides%20based%20on%20info%20in%20the%20sheet.%26nbsp%3B%20Currently%2C%20I%20am%20able%20to%20create%20the%20correct%20number%20of%20slides%2C%20and%20Cell%201%20and%20Cell%202%20both%20carry%20over%20to%20the%20slides%20perfectly.%26nbsp%3B%20What%20I%20would%20like%20to%20do%20is%20carry%20over%20more%20than%20just%20those%202.%26nbsp%3B%20I%20will%20paste%20the%20macro%20here%20for%20your%20reference%3A%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CPRE%3ESub%20CreateSlidesTest_Text2()%0A'https%3A%2F%2Fwww.contextures.com%0A'create%20slide%20for%20names%0A'%20that%20pass%20criteria%20test%0A'fill%20two%20text%20boxes%0ADim%20myPT%20As%20Presentation%0ADim%20myMain%20As%20Slide%0ADim%20myDup%20As%20Slide%0A%0ADim%20xlApp%20As%20Object%0ADim%20wbA%20As%20Object%0ADim%20wsA%20As%20Object%0ADim%20myList%20As%20Object%0ADim%20myRng%20As%20Object%0ADim%20i%20As%20Long%0ADim%20col01%20As%20Long%0ADim%20col02%20As%20Long%0ADim%20colTest%20As%20Long%0ADim%20strTest%20As%20String%0A%0A'columns%20with%20text%20for%20slides%0Acol01%20%3D%201%0Acol02%20%3D%202%0A'test%20column%20and%20criterion%0AcolTest%20%3D%203%0AstrTest%20%3D%20%22y%22%0A%0AOn%20Error%20Resume%20Next%0ASet%20myPT%20%3D%20ActivePresentation%0ASet%20myMain%20%3D%20myPT.Slides(1)%0A%0ASet%20xlApp%20%3D%20GetObject(%2C%20%22Excel.Application%22)%0ASet%20wbA%20%3D%20xlApp.ActiveWorkbook%0ASet%20wsA%20%3D%20wbA.ActiveSheet%0ASet%20myList%20%3D%20wsA.ListObjects(1)%0AOn%20Error%20GoTo%20errHandler%0A%0AIf%20Not%20myList%20Is%20Nothing%20Then%0A%20%20%0A%20%20Set%20myRng%20%3D%20myList.DataBodyRange%0A%20%20%0A%20%20For%20i%20%3D%201%20To%20myRng.Rows.Count%0A%20%20%20%20'Copy%20first%20slide%2C%20paste%20after%20last%20slide%0A%20%20%20%20If%20UCase(wsA.Cells(i%2C%20colTest).Value)%20_%0A%20%20%20%20%20%20%20%20%3D%20UCase(strTest)%20Then%0A%20%20%20%20%20%20With%20myPT%0A%20%20%20%20%20%20%20%20'Duplicate%20slide%201%2C%20move%20after%20last%20slide%0A%20%20%20%20%20%20%20%20myMain.Duplicate%0A%20%20%20%20%20%20%20%20Set%20myDup%20%3D%20.Slides(2)%0A%20%20%20%20%20%20%20%20myDup.MoveTo%20myPT.Slides.Count%0A%20%20%20%20%20%20%20%20%0A%20%20%20%20%20%20%20%20'change%20text%20in%201st%20textbox%0A%20%20%20%20%20%20%20%20myDup.Shapes(1).TextFrame.TextRange.Text%20_%0A%20%20%20%20%20%20%20%20%20%20%20%20%3D%20myRng.Cells(i%2C%20col01).Value%0A%20%20%20%20%20%20%20%20%20%0A%20%20%20%20%20%20%20%20%20'change%20text%20in%202nd%20textbox%0A%20%20%20%20%20%20%20%20myDup.Shapes(2).TextFrame.TextRange.Text%20_%0A%20%20%20%20%20%20%20%20%20%20%20%20%3D%20myRng.Cells(i%2C%20col02).Value%0A%20%20%20%20%20%20End%20With%0A%20%20%20%20End%20If%0A%20%20Next%0AElse%0A%20%20MsgBox%20%22No%20Excel%20table%20found%20on%20active%20sheet%22%0A%20%20GoTo%20exitHandler%0AEnd%20If%0A%0AexitHandler%3A%0A%20%20Exit%20Sub%0AerrHandler%3A%0A%20%20MsgBox%20%22Could%20not%20complete%20slides%22%0A%20%20Resume%20exitHandler%3A%0AEnd%20Sub%3C%2FPRE%3E%3CP%3E%3CFONT%20color%3D%22%23000000%22%3ECredit%20for%20the%20macro%20here%3A%3C%2FFONT%3E%3C%2FP%3E%3CP%3E%3CFONT%20color%3D%22%23000000%22%3E%3CA%20href%3D%22https%3A%2F%2Fwww.contextures.com%2Fexcelpowerpointslideslist.html%22%20target%3D%22_blank%22%20rel%3D%22nofollow%20noopener%20noreferrer%22%3Ehttps%3A%2F%2Fwww.contextures.com%2Fexcelpowerpointslideslist.html%3C%2FA%3E%3C%2FFONT%3E%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%3CFONT%20color%3D%22%23000000%22%3EI%20added%20a%3C%2FFONT%3E%3C%2FP%3E%3CPRE%3EDim%20col03%20As%20Long%3CBR%20%2F%3E%3CBR%20%2F%3Eand%3CBR%20%2F%3E%3CBR%20%2F%3Ecol03%20%3D%207%3CBR%20%2F%3E%3CBR%20%2F%3Eand%20%3CBR%20%2F%3E%3CBR%20%2F%3E%20'change%20text%20in%203rd%20textbox%20%3CBR%20%2F%3EmyDup.Shapes(3).TextFrame.TextRange.Text%20_%20%3CBR%20%2F%3E%3D%20myRng.Cells(i%2C%20col03).Value%3C%2FPRE%3E%3CP%3E%3CFONT%20color%3D%22%23000000%22%3EWhat%20am%20I%20missing%3F%26nbsp%3B%20I%20would%20like%20to%20pull%20around%205%20-%208%20cells%20from%20the%20excel%20sheet%20to%20the%20slides%2C%20eventually.%3C%2FFONT%3E%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%3CFONT%20color%3D%22%23000000%22%3ETHANKS!%3C%2FFONT%3E%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-2464075%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EPowerPoint%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E
Occasional Visitor

Hello all!  I am working with a macro that will pull data from an active Excel sheet and create slides based on info in the sheet.  Currently, I am able to create the correct number of slides, and Cell 1 and Cell 2 both carry over to the slides perfectly.  What I would like to do is carry over more than just those 2.  I will paste the macro here for your reference:

 

Sub CreateSlidesTest_Text2()
'https://www.contextures.com
'create slide for names
' that pass criteria test
'fill two text boxes
Dim myPT As Presentation
Dim myMain As Slide
Dim myDup As Slide

Dim xlApp As Object
Dim wbA As Object
Dim wsA As Object
Dim myList As Object
Dim myRng As Object
Dim i As Long
Dim col01 As Long
Dim col02 As Long
Dim colTest As Long
Dim strTest As String

'columns with text for slides
col01 = 1
col02 = 2
'test column and criterion
colTest = 3
strTest = "y"

On Error Resume Next
Set myPT = ActivePresentation
Set myMain = myPT.Slides(1)

Set xlApp = GetObject(, "Excel.Application")
Set wbA = xlApp.ActiveWorkbook
Set wsA = wbA.ActiveSheet
Set myList = wsA.ListObjects(1)
On Error GoTo errHandler

If Not myList Is Nothing Then
  
  Set myRng = myList.DataBodyRange
  
  For i = 1 To myRng.Rows.Count
    'Copy first slide, paste after last slide
    If UCase(wsA.Cells(i, colTest).Value) _
        = UCase(strTest) Then
      With myPT
        'Duplicate slide 1, move after last slide
        myMain.Duplicate
        Set myDup = .Slides(2)
        myDup.MoveTo myPT.Slides.Count
        
        'change text in 1st textbox
        myDup.Shapes(1).TextFrame.TextRange.Text _
            = myRng.Cells(i, col01).Value
         
         'change text in 2nd textbox
        myDup.Shapes(2).TextFrame.TextRange.Text _
            = myRng.Cells(i, col02).Value
      End With
    End If
  Next
Else
  MsgBox "No Excel table found on active sheet"
  GoTo exitHandler
End If

exitHandler:
  Exit Sub
errHandler:
  MsgBox "Could not complete slides"
  Resume exitHandler:
End Sub

Credit for the macro here:

https://www.contextures.com/excelpowerpointslideslist.html

 

I added a

Dim col03 As Long

and

col03 = 7

and

'change text in 3rd textbox
myDup.Shapes(3).TextFrame.TextRange.Text _
= myRng.Cells(i, col03).Value

What am I missing?  I would like to pull around 5 - 8 cells from the excel sheet to the slides, eventually.

 

THANKS!

0 Replies