Clicking shape to get a text

[shani20]

I'm working on drawing (you may suggest a better solution). I am trying to do random drawing. When you click a box, the text will show up in the shape. But the problem that I am having right now. VBA seems to like a specific shape. I can't get it range so if I click this specific shape, I want it to show up text, then I click on the next shape, I want the text to show in THAT shape so on.

I have 8 pools (slides) with 8 shapes some already are pre selected, some I need to draw from the list. I already developed a code and it works.

The code is here -


Sub School_Draw()

Dim Schools() As String
Dim strSchool As String
Dim Ichosen As Integer

Schools = (Split("Wyoming DOH/Delaware SD/Southern Oregon ESD/American SD/St. Mary's SD/" & _
"Washington SD/Mill Neck Manor SD/CSD Fremont/New York SD/Georgia SD/Austine SD/" & _
"Plano RDSPD/New Bedford HS/Grants Pass HS/Hawaii SD/Kennesaw Mountain HS/" & _
"North Carolina SD/South Plantation HS/Virginia SDB/W. T. Woodson HS/Atlanta Area SD/" & _
"Pennsylvania SD/Middle College HS/South Carolina SDB/Idaho SDB/SCCOE-Leigh HS/" & _
"Wisconsin SD/Iowa SD/Missouri SD/South Hills HS/Mississippi SD/New York SSD/" & _
"Pinellas Park HS/Pearl City HS/Cumberland County HS/Derby HS/Oregon SD/WPSD-SSSD/READS/" & _
"Rockville HS/West Virginia SDB/Upper Arlington HS/Governor Baxter SD/Phoenix Day SD/" & _
"White Station HS/Michigan SD/Whitney Young HS/Arkansas SD/Taft HS/Oklahoma SD", "/"))

Do
Randomize

Ichosen = Int(Rnd * (UBound(Schools) + 1))
strSchool = (Schools(Ichosen))

With ActivePresentation.Slides(1).Shapes(8)
.TextFrame.TextRange.Text = strSchool
.Visible = True

End With

Schools(Ichosen) = Schools(UBound(Schools))

If UBound(Schools) > 0 Then

ReDim Preserve Schools(0 To UBound(Schools) - 1)
Else

Exit Sub

End If

Loop

End Sub

[John Wilson]

See if this works:

Public b_split As Boolean
Public Schools() As String
Sub School_Draw(oshp As Shape)

Dim strSchool As String
Dim Ichosen As Integer
If b_split = False Then
Schools = (Split("Wyoming DOH/Delaware SD/Southern Oregon ESD/American SD/St. Mary's SD/" & _
"Washington SD/Mill Neck Manor SD/CSD Fremont/New York SD/Georgia SD/Austine SD/" & _
"Plano RDSPD/New Bedford HS/Grants Pass HS/Hawaii SD/Kennesaw Mountain HS/" & _
"North Carolina SD/South Plantation HS/Virginia SDB/W. T. Woodson HS/Atlanta Area SD/" & _
"Pennsylvania SD/Middle College HS/South Carolina SDB/Idaho SDB/SCCOE-Leigh HS/" & _
"Wisconsin SD/Iowa SD/Missouri SD/South Hills HS/Mississippi SD/New York SSD/" & _
"Pinellas Park HS/Pearl City HS/Cumberland County HS/Derby HS/Oregon SD/WPSD-SSSD/READS/" & _
"Rockville HS/West Virginia SDB/Upper Arlington HS/Governor Baxter SD/Phoenix Day SD/" & _
"White Station HS/Michigan SD/Whitney Young HS/Arkansas SD/Taft HS/Oklahoma SD", "/"))
b_split = True
End If
Randomize
Ichosen = Int(Rnd * (UBound(Schools) + 1))
Debug.Print Ichosen
Debug.Print Schools(Ichosen)
strSchool = (Schools(Ichosen))
With oshp
If .HasTextFrame Then
.TextFrame.TextRange.Text = strSchool
End If
End With
Schools(Ichosen) = Schools(UBound(Schools))
If UBound(Schools) > 0 Then
ReDim Preserve Schools(0 To UBound(Schools) - 1)
Else
MsgBox "All names drawn"
b_split = False
Exit Sub
End If
End Sub

[shani20]

It works - thanks! I will add reset code so every time I open it in slideshow, it will clean all shapes.

Really appreciated it!

Shannon

[John Wilson]

No problem, I can see you already visit our site!