Loop to Copy Text From Excel to Powerpoint Text Boxes

[Newibie_VB8]

Hello,

I am a beginier VBA and have 1 post in the powerpoint help thread.

Wanted to post in here and try and get some direction.

The back story:

I have been able to figure out how to copy and past from excel cells to powerpoint by naming and calling out each text box.

Here is an example of my code that is working

Private Sub CommandButton1_Click()
Dim oXL As Object 'Excel.Application
Dim oWB As Object 'Excel.Workbook
Dim oSld As Slide
Set oXL = CreateObject("Excel.Application")
Set oWB = oXL.Workbooks.Open(FileName:="C:\Users\smaurer\Documents\AutoFillpptTextBox\textbox_auto_copy_template.xl sx")
Set oSld = ActivePresentation.Slides(5)
' e.g. oSld.Shapes("Textbox 10").TextFrame.TextRange.Text = oWB.Sheets(1).Range("A1").Value
' Copy cell contents from the 1st sheet in Excel to the textboxes in PowerPoint.

oSld.Shapes("Name1").TextFrame.TextRange.Text = oWB.Sheets(1).Range("B5").Value
oSld.Shapes("Name2").TextFrame.TextRange.Text = oWB.Sheets(1).Range("B6").Value
oSld.Shapes("Name3").TextFrame.TextRange.Text = oWB.Sheets(1).Range("B7").Value
oSld.Shapes("Name4").TextFrame.TextRange.Text = oWB.Sheets(1).Range("B8").Value
oSld.Shapes("Name5").TextFrame.TextRange.Text = oWB.Sheets(1).Range("B9").Value
oSld.Shapes("Name6").TextFrame.TextRange.Text = oWB.Sheets(1).Range("B10").Value
oSld.Shapes("Name7").TextFrame.TextRange.Text = oWB.Sheets(1).Range("B11").Value
oSld.Shapes("Name8").TextFrame.TextRange.Text = oWB.Sheets(1).Range("B12").Value
oSld.Shapes("Name9").TextFrame.TextRange.Text = oWB.Sheets(1).Range("B13").Value
oSld.Shapes("Name10").TextFrame.TextRange.Text = oWB.Sheets(1).Range("B14").Value
oSld.Shapes("Name11").TextFrame.TextRange.Text = oWB.Sheets(1).Range("B15").Value
oSld.Shapes("Name12").TextFrame.TextRange.Text = oWB.Sheets(1).Range("B16").Value
oSld.Shapes("Name13").TextFrame.TextRange.Text = oWB.Sheets(1).Range("B17").Value
oSld.Shapes("Name14").TextFrame.TextRange.Text = oWB.Sheets(1).Range("B18").Value

oWB.Close
oXL.Quit
Set oWB = Nothing
Set oXL = Nothing
End Sub


I am trying to shorten this with a loop. And keep getting a type mismatch error.


Sub Auto_Import_Excel()

Dim oXL As Object 'Excel.Application
Dim oWB As Object 'Excel.Workbook
Dim oSld As Slide
Set oXL = CreateObject("Excel.Application")
Set oWB = oXL.Workbooks.Open(FileName:="C:\Users\smaurer\Documents\AutoFillpptTextBox\textbox_auto_copy_template_VB 2.xlsx ")
Set oSld = ActivePresentation.Slides(3)

Dim cellNumber As Integer
Dim j As Integer
For j = 1 To 14
cellNumber = j + 4

oSld.Shapes("Name" + j).TextFrame.TextRange.Text = oWB.Sheets(1).Range("B" + cellNumber).Value

Next j

oWB.Close
oXL.Quit
Set oWB = Nothing
Set oXL = Nothing
End Sub




I do not know why I cannot loop this???

Also I have a question about the file name, is there anyway to reference the file so that I could send the powerpoint and the excel to someone and they would be able to save the excel file and then run the code without touching the VBE ?

Thanks!!

[Tinbendr]

Try using ampersand instead.

oSld.Shapes("Name" & j).TextFrame.TextRange.Text = oWB.Sheets(1).Range("B" & cellNumber).Value

2. You can password protect the VBE project.

[snb]

I'd use:

Private Sub CommandButton1_Click()
sn=getobject("C:\Users\smaurer\Documents\AutoFillpptTextBox\textbox_auto_copy_template.xl sx").sheets(1).range("B5:B18")

for j=1 to ubound(sn)
ActivePresentation.Slides(5).Shapes("Name" & j").TextFrame.TextRange.Text = sn(j,1)
next
End Sub