Combining VBA code

[MarkNie]

Hi All

I was wondering if anybody can shed some light or point me in the right direction.

I am busy writing some code to pull data from excel into powerpoint textboxes. I have managed to do this without any issues.

The problem I am having now is that I have to write a bit of code for each text box which is going to take forever as there will be over 150 of them.

I there anyway to combine the code maybe in a loop (which I don't understand to well) or just a simpler way of doing it.

Code:
Dim strReplaceText As String

strReplaceText1 = Range("C2")
strReplaceText2 = Range("D2")
strReplaceText3 = Range("G2")

ActivePresentation.Slides(2).Shapes("Textbox1").Select
ActiveWindow.Selection.TextRange.Text = strReplaceText1

ActivePresentation.Slides(2).Shapes("Textbox2").Select
ActiveWindow.Selection.TextRange.Text = strReplaceText2

ActivePresentation.Slides(2).Shapes("Textbox3").Select
ActiveWindow.Selection.TextRange.Text = strReplaceText3

ActivePresentation.Slides(3).Select


strReplaceText4 = Range("C3")
strReplaceText5 = Range("D3")
strReplaceText6 = Range("G3")

ActivePresentation.Slides(3).Shapes("Textbox4").Select
ActiveWindow.Selection.TextRange.Text = strReplaceText4

ActivePresentation.Slides(3).Shapes("Textbox5").Select
ActiveWindow.Selection.TextRange.Text = strReplaceText5

ActivePresentation.Slides(3).Shapes("Textbox6").Select
ActiveWindow.Selection.TextRange.Text = strReplaceText6


strReplaceText7 = Range("C4")
strReplaceText8 = Range("D4")
strReplaceText9 = Range("G4")

ActivePresentation.Slides(3).Shapes("Textbox7").Select
ActiveWindow.Selection.TextRange.Text = strReplaceText7

ActivePresentation.Slides(3).Shapes("Textbox8").Select
ActiveWindow.Selection.TextRange.Text = strReplaceText8

ActivePresentation.Slides(3).Shapes("Textbox9").Select
ActiveWindow.Selection.TextRange.Text = strReplaceText9

Is there a way that you could just run through all the rows in excel an populate the textboxes in ppt without having to write each line for a row and textbox.

I hope this makes sense, please let me know if you need a better explenation.

Thanks

 

[PHV]

Anyway, replace this:
With ActiveSheet
with this:
With XlsxApp.ActiveSheet

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[SkipVought]

faq707-4594

UWhen your code errors, hit DEBUG and then use the Watch Window to discover what is happening with your objects and variables.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[fumei]

I am sorry, but I am going to have to come down on the side of this is not - currently - possible. Look at the logic involved.

Slide 1
Textbox1 = C2
Textbox2 = D2
Textbox3 = G2

Textbox4 = C3
Textbox5 = D3
Textbox6 = G3

Slide 2
Textbox7 = C2
Textbox8 = D2
Textbox9 = G2

Textbox10 = C4
Textbox11 = D4
Textbox12 = G4

Textbox13 = C5
Textbox14 = D5
Textbox15 = G5

I defy anyone to state what the logic actually is!

The number of textboxes per slide is unknown, it could be three, it could be 9.

All we know is - apparently the "first three" - but by name(???) get the same values (C2,D2,G2), and then next "three" (by name?) get Cx, Dx, Gx.

True, from earlier iteration it should be possible to detrmine the x of those. Each iteration of a slide can increase x + 1. However, THEN, the next three - if there IS three - get x + 2.

The only way i see this functioning in an automatated way is to;

1. Loop through the slides
2. For each slide, get a textbox count
3. NOW starting getting the data and putting into the textboxes.

I have grave concerns though that the naming of the textboxes is likely to bite the code in the butt.

Gerry

 

[MarkNie]

Hi Gerry

Thank you for your reply.

I agree with you it seems this is not currently possible. I will have to think of a better way to attack this problem.

Maybe my thought process on the way this could work is not correct.

Main aim I am trying to get out of this is that we have 150 staff with name, title and biog fields in an excel document which get updated frequently. I just want to setup a ppt master document which has all the up to date biogs in for people to use. Maybe it is just as simple of creating each textbox with the persons same eg. Mark1, Mark2, Mark3 which then links to the specific fields in excel and update when you open the ppt document.

Thanks again to everyone for all your help in trying to solve this problem.

Regards
Mark

 

[SkipVought]

The uncertainty of how many names you have in your workbook is not a problem.

This issue is MAPPING this data to your presentation.

What is the logic that relates your staff members to a particular slide?

What is the logic for the different number of text boxes on a slide? Is the grouping related to some parameter of data in the workbook, like department, or topic?

Once this logic is identified, then the process of mapping the data is pretty simple.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[MarkNie]

Hi All

I finally got to the bottom of this.

Please see code below:

Sub UpdateBiogs()

' This requires that you set a reference to Excel in Tools, References
' You could later change these to As Object to avoid that necessity
Dim XlsxApp As Excel.Application
Dim XlsxWork As Excel.Workbook
Dim XlsxFile As String
Dim RowNum As Integer
Dim iSlide As Integer
Dim aSlide As Integer
Dim nSlide As Integer
Dim i As Integer
Dim lRow As Integer
Dim sValue As String


XlsxFile = "C:\Biographies.xlsx"

' Get a reference to Excel app
Set XlsxApp = New Excel.Application
XlsxApp.Visible = True

' Open our source Excel file, get a reference to it
Set XlsxWork = XlsxApp.Workbooks.Open(XlsxFile)

'check the excel rows against the number of slides
RowNum = ActiveSheet.UsedRange.Rows.Count

RowNum = RowNum - 1

iSlide = ActivePresentation.Slides.Count

'if rows are more than slides move to last slide and add the difference in slides
If RowNum > iSlide Then

aSlide = RowNum - iSlide
nSlide = iSlide + 1

'loop through and add slides
For i = 1 To aSlide

Dim ppSlide1 As PowerPoint.Slide
Set ppSlide1 = ActivePresentation.Slides.Add(nSlide, ppLayoutCustom)

Next

'Move to first slide
With Application.ActiveWindow
.ViewType = ppViewSlide
.View.GotoSlide 1
End With

'update each slide with correct data
With Excel.ActiveSheet
iSlide = 0
For lRow = 2 To .[C2].End(xlDown).Row
iSlide = iSlide + 1
For i = 1 To 3
Select Case i
Case 1
sValue = .Cells(lRow, "A").Value
ActivePresentation.Slides(iSlide).Select
ActivePresentation.Slides(iSlide).Shapes("Text Placeholder 1").Select
ActiveWindow.Selection.TextRange.Text = sValue
Case 2
sValue = .Cells(lRow, "B").Value
ActivePresentation.Slides(iSlide).Select
ActivePresentation.Slides(iSlide).Shapes("Text Placeholder 2").Select
ActiveWindow.Selection.TextRange.Text = sValue
Case 3
sValue = .Cells(lRow, "C").Value
ActivePresentation.Slides(iSlide).Select
ActivePresentation.Slides(iSlide).Shapes("Text Placeholder 3").Select
ActiveWindow.Selection.TextRange.Text = sValue
End Select

Next
Next
End With

ElseIf RowNum < iSlide Then
'if rows are equal to then just update slides
MsgBox "There are 2 many slides for the number of records in excel, check which one has been removed and delete that slide from PowerPoint"


ElseIf RowNum = iSlide Then
'update each slide with correct data

'Move to first slide
With Application.ActiveWindow
.ViewType = ppViewSlide
.View.GotoSlide 1
End With


With Excel.ActiveSheet
iSlide = 0
For lRow = 2 To .[C2].End(xlDown).Row
iSlide = iSlide + 1
For i = 1 To 3
Select Case i
Case 1
sValue = .Cells(lRow, "A").Value
ActivePresentation.Slides(iSlide).Select
ActivePresentation.Slides(iSlide).Shapes("Text Placeholder 1").Select
ActiveWindow.Selection.TextRange.Text = sValue
Case 2
sValue = .Cells(lRow, "B").Value
ActivePresentation.Slides(iSlide).Select
ActivePresentation.Slides(iSlide).Shapes("Text Placeholder 2").Select
ActiveWindow.Selection.TextRange.Text = sValue
Case 3
sValue = .Cells(lRow, "C").Value
ActivePresentation.Slides(iSlide).Select
ActivePresentation.Slides(iSlide).Shapes("Text Placeholder 3").Select
ActiveWindow.Selection.TextRange.Text = sValue
End Select

Next
Next
End With

End If


' Close the excel file
XlsxWork.Close
XlsxApp.Quit



MsgBox "Update of the Staff Biographies complete!"

End Sub


Hope this helps someone

 

[SkipVought]

It would be much more instructive to 1) state your logic and 2) your method of approch, than just throw up 128 lines of code

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]