Mypt hub

"y"On Error Resume NextSet myPT = ActivePresentationSet myMain = myPT.Slides(1)Set xlApp = GetObject(, "Excel.Application")Set wbA = xlApp.ActiveWorkbookSet wsA = wbA.ActiveSheetSet myList = wsA.ListObjects(1)On Error GoTo errHandlerIf 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(myRng.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 NextElse MsgBox "No Excel table found on active sheet" GoTo exitHandlerEnd IfexitHandler: Exit SuberrHandler: MsgBox "Could not complete slides" Resume exitHandler:End Sub All Items - 1 Text This macro creates slides for all items in the Excel list, and fills 1 text box. In the PowerPoint slide, text from the specified column (col01), is entered in the 1st text box Sub CreateSlides_Text1()' slide for each name in list'fill one text boxDim myPT As PresentationDim myMain As SlideDim myDup As SlideDim xlApp As ObjectDim wbA As ObjectDim wsA As ObjectDim myList As ObjectDim myRng As ObjectDim i As LongDim col01 As Long'column with text for slidescol01 = 1On Error Resume NextSet myPT = ActivePresentationSet myMain = myPT.Slides(1)Set xlApp = GetObject(, "Excel.Application")Set wbA = xlApp.ActiveWorkbookSet wsA = wbA.ActiveSheetSet myList = wsA.ListObjects(1)On Error GoTo errHandlerIf Not myList Is Nothing Then Set myRng = myList.DataBodyRange For i = 1 To myRng.Rows.Count With myPT 'Duplicate slide 1, move after last

Text for slidescol01 = 1'test column and criterioncolTest = 3strTest = "y"On Error Resume NextSet myPT = ActivePresentationSet myMain = myPT.Slides(1)Set xlApp = GetObject(, "Excel.Application")Set wbA = xlApp.ActiveWorkbookSet wsA = wbA.ActiveSheetSet myList = wsA.ListObjects(1)On Error GoTo errHandlerIf 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(myRng.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 End With End If NextElse MsgBox "No Excel table found on active sheet" GoTo exitHandlerEnd IfexitHandler: Exit SuberrHandler: MsgBox "Could not complete slides" Resume exitHandler:End Sub Criteria Test - 2 Text This macro creates slides for items in the Excel list, after checking a criteria cell, and fills 2 text boxes. In Excel, checks the test column (colTest), and creates a slide if it contains the specified text string (strTest) In the PowerPoint slide, text from the specified columns (col01 and col02), is entered in the 1st text box and 2nd text box Sub CreateSlidesTest_Text2()' slide for names' that pass criteria test'fill two text boxesDim myPT As PresentationDim myMain As SlideDim myDup As SlideDim xlApp As ObjectDim wbA As ObjectDim wsA As ObjectDim myList As ObjectDim myRng As ObjectDim i As LongDim col01 As LongDim col02 As LongDim colTest As LongDim strTest As String'columns with text for slidescol01 = 1col02 = 2'test column and criterioncolTest = 3strTest =

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 End With Next iElse MsgBox "No Excel table found on active sheet" GoTo exitHandlerEnd IfexitHandler: Exit SuberrHandler: MsgBox "Could not complete slides" Resume exitHandler:End Sub All Items - 2 Text This macro creates slides for all items in the Excel list, and fills 2 text boxes. In the PowerPoint slide, text from the specified columns (col01 and col02), is entered in the 1st text box and 2nd text box Sub CreateSlides_Text2()' slide for each name in list'fill two text boxesDim myPT As PresentationDim myMain As SlideDim myDup As SlideDim xlApp As ObjectDim wbA As ObjectDim wsA As ObjectDim myList As ObjectDim myRng As ObjectDim i As LongDim col01 As LongDim col02 As Long'columns with text for slidescol01 = 1col02 = 2On Error Resume NextSet myPT = ActivePresentationSet myMain = myPT.Slides(1)Set xlApp = GetObject(, "Excel.Application")Set wbA = xlApp.ActiveWorkbookSet wsA = wbA.ActiveSheetSet myList = wsA.ListObjects(1)On Error GoTo errHandlerIf Not myList Is Nothing Then Set myRng = myList.DataBodyRange For i = 1 To myRng.Rows.Count 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 NextElse MsgBox "No Excel table found on active sheet" GoTo exitHandlerEnd IfexitHandler: Exit SuberrHandler: MsgBox "Could not complete slides" Resume exitHandler:End Sub Download Sample File To get the PowerPoint and Excel files from