- Joined
- Nov 5, 2012
- Messages
- 1
- Reaction score
- 0
I have ppt file which several text boxes in each slide (20 slodes). I need to get data from excel 2010 column to powerpoint 2010 text boxes. When I created the ppt file, I copied slides to create new slides so I can use the existing structure. I got the vba code to wotj which displays text box names in powerpoint and fill each box with it's name. this is the code
Sub NameRef()
'
j = 1
Do While j < Application.ActivePresentation.Slides.Count + 1
Application.ActivePresentation.Slides(j).Select
'Check table name
i = 1
Do While i < ActiveWindow.Selection.SlideRange.Shapes.Count + 1
If ActiveWindow.Selection.SlideRange.Shapes.Item(i).HasTable = msoTrue Then
ActiveWindow.Selection.SlideRange.Shapes.Item(i).Table.Cell(1, 1).Shape.TextFrame.TextRange.Text = ActiveWindow.Selection.SlideRange.Shapes.Item(i).Name
c = c + 1
End If
i = i + 1
Loop
i = 1
Do While i < ActiveWindow.Selection.SlideRange.Shapes.Count + 1
If ActiveWindow.Selection.SlideRange.Shapes.Item(i).HasTextFrame = msoTrue Then 'And _
Left(ActiveWindow.Selection.SlideRange.Shapes.Item(i).Name, 1, 8) = "Textbox"
If Mid(ActiveWindow.Selection.SlideRange.Shapes.Item(i).TextFrame.TextRange.Text, 1, 6) = "10,000" Or Mid(ActiveWindow.Selection.SlideRange.Shapes.Item(i).TextFrame.TextRange.Text, 1, 6) = "20,000" Or Mid(ActiveWindow.Selection.SlideRange.Shapes.Item(i).TextFrame.TextRange.Text, 1, 6) = "30,000" Then
ActiveWindow.Selection.SlideRange.Shapes.Item(i).TextFrame.TextRange.Text = Mid(ActiveWindow.Selection.SlideRange.Shapes.Item(i).Name, 9, Len(ActiveWindow.Selection.SlideRange.Shapes.Item(i).Name))
ActiveWindow.Selection.SlideRange.Shapes.Item(i).TextFrame.TextRange.Font.Size = "6"
ActiveWindow.Selection.SlideRange.Shapes.Item(i).Width = 36#
c = c + 1
End If
End If
i = i + 1
Loop
j = j + 1
Loop
Application.ActivePresentation.SaveAs FileName:=Application.ActivePresentation.Path & "\" & Mid(Application.ActivePresentation.Name, 1, Len(Application.ActivePresentation.Name) - 4) & "Ref.PPT"
Application.ActivePresentation.Close
End Sub
Since I copied text boxes from one slide to another, text box names are same, they are not unique. (slide 1 and slide 2 where text boxes are at same position/location, due to the fact the slide1 is copied to create slide 2, have same text box numbers). Is there anyway I can reset them to start all again or Is there another reference/identifier for each textbox which is unique from other text boxes.
2nd, Is there a code to export from excel to power point using these text box names? I did a search and I could not find an answer. any help/suggestion is welcome.
Thanks,
Sub NameRef()
'
j = 1
Do While j < Application.ActivePresentation.Slides.Count + 1
Application.ActivePresentation.Slides(j).Select
'Check table name
i = 1
Do While i < ActiveWindow.Selection.SlideRange.Shapes.Count + 1
If ActiveWindow.Selection.SlideRange.Shapes.Item(i).HasTable = msoTrue Then
ActiveWindow.Selection.SlideRange.Shapes.Item(i).Table.Cell(1, 1).Shape.TextFrame.TextRange.Text = ActiveWindow.Selection.SlideRange.Shapes.Item(i).Name
c = c + 1
End If
i = i + 1
Loop
i = 1
Do While i < ActiveWindow.Selection.SlideRange.Shapes.Count + 1
If ActiveWindow.Selection.SlideRange.Shapes.Item(i).HasTextFrame = msoTrue Then 'And _
Left(ActiveWindow.Selection.SlideRange.Shapes.Item(i).Name, 1, 8) = "Textbox"
If Mid(ActiveWindow.Selection.SlideRange.Shapes.Item(i).TextFrame.TextRange.Text, 1, 6) = "10,000" Or Mid(ActiveWindow.Selection.SlideRange.Shapes.Item(i).TextFrame.TextRange.Text, 1, 6) = "20,000" Or Mid(ActiveWindow.Selection.SlideRange.Shapes.Item(i).TextFrame.TextRange.Text, 1, 6) = "30,000" Then
ActiveWindow.Selection.SlideRange.Shapes.Item(i).TextFrame.TextRange.Text = Mid(ActiveWindow.Selection.SlideRange.Shapes.Item(i).Name, 9, Len(ActiveWindow.Selection.SlideRange.Shapes.Item(i).Name))
ActiveWindow.Selection.SlideRange.Shapes.Item(i).TextFrame.TextRange.Font.Size = "6"
ActiveWindow.Selection.SlideRange.Shapes.Item(i).Width = 36#
c = c + 1
End If
End If
i = i + 1
Loop
j = j + 1
Loop
Application.ActivePresentation.SaveAs FileName:=Application.ActivePresentation.Path & "\" & Mid(Application.ActivePresentation.Name, 1, Len(Application.ActivePresentation.Name) - 4) & "Ref.PPT"
Application.ActivePresentation.Close
End Sub
Since I copied text boxes from one slide to another, text box names are same, they are not unique. (slide 1 and slide 2 where text boxes are at same position/location, due to the fact the slide1 is copied to create slide 2, have same text box numbers). Is there anyway I can reset them to start all again or Is there another reference/identifier for each textbox which is unique from other text boxes.
2nd, Is there a code to export from excel to power point using these text box names? I did a search and I could not find an answer. any help/suggestion is welcome.
Thanks,