vba ppt 2007/2010 compatibility issue: ShapeID doesn't work

[pptSam]

Hello again

So, as announced, this is the second post about my ppt 2007/2010 compatibility problems.

What I wanted to achieve:
I wrote some code to change the colour and border-weight when the shape is clicked. Then I introduced a code to turn the shape back to the original state, when it is klicked again (=deaktivated). I did this by storing the information on the original shape-state in special five-dimensional datafield variables. When needed, this information could be retrieved from these variables and the values applied to the shape. This worked fine in ppt 2010 but not anymore with ppt 2007. Here is the code I am using:


Public Sub KlickStatus(oshp as shape)
set Pshp = oshp

Dim sld As Slide
Dim shp As Shape

Set PshpKlickedShp(a, b, c, d, e) = Pshp

'stores the color of the shape
PsglShpColor(a, b, c, d, e) = Pshp.Line.ForeColor.RGB
'stores the visibility-state of the shape
PbolVisState(a, b, c, d, e) = Pshp.Line.Visible

'call the sub to change the color to "activated"
SetBorderActivated
end sub

Public Sub SetBorderActivated(oshp As Shape)
Set Pshp = oshp

With Pshp.Line
.ForeColor.RGB = RGB(255, 0, 0) 'colour red
.Visible = msoTrue
.Weight = 4.5
End With

end sub


'Now, I want to "deactivate" (=reset to original) the shape with the following code
Public Sub ResetBorder()
'first the script sets the variables a,b,c,d,e to the appropriate values (code not given here)
Dim sld As Slide
Dim shp As Shape
Dim Index As Single
Dim ID As Single

Set shp = PshpKlickedShp(a, b, c, d, e)
ID = shp.ID

Set sld = PshpKlickedShp(a, b, c, d, e).Parent
Index = sld.SlideIndex

With Application.ActivePresentation.Slides(Index).Shapes(ID).Line
.Weight = PsglWeight(a, b, c, d, e)
.ForeColor.RGB = PsglShpColor(a, b, c, d, e)
.Visible = PbolVisState(a, b, c, d, e)
End With

end sub


As I said: it worked in ppt 2010 but not with ppt 2007. In debug mode I find an error massage saying: "Shapes (unkonwn member): Integer out of range. 19 is not in the valid range of 1 to 8."
The problem with this is, that the ShapeID 19 really is correct. So, I just don't understand the error.

Any help on this is highly appreciated...

[Cosmo]

Set shp = PshpKlickedShp(a, b, c, d, e)
ID = shp.ID

Set sld = PshpKlickedShp(a, b, c, d, e).Parent
Index = sld.SlideIndex

With Application.ActivePresentation.Slides(Index).Shapes(ID).Line
.Weight = PsglWeight(a, b, c, d, e)
.ForeColor.RGB = PsglShpColor(a, b, c, d, e)
.Visible = PbolVisState(a, b, c, d, e)
End With



If you already have a reference to the shape you want (shp), then why are you getting the slide number and shape ID to reference it again? You should just be able to use:
Set shp = PshpKlickedShp(a, b, c, d, e)

With shp.Line
.Weight = PsglWeight(a, b, c, d, e)
.ForeColor.RGB = PsglShpColor(a, b, c, d, e)
.Visible = PbolVisState(a, b, c, d, e)
End With



Edit: I see better what you are doing now.

Are you sure there are the proper amount of shapes on the second slide?

Edit#2: I'm still confused. It appears to me that both would refer to the same shape.

Does "Application.ActivePresentation.Slides(Index).Shapes(ID).Line" refer to the same shape referred to in the 'shp' variable?

[John Wilson]

I'm confused too as to what you need but maybe this will give a start
Sub activshape(oshp As Shape)
If oshp.Tags.Count = 0 Then
oshp.Tags.Add "COL", CStr(oshp.Fill.ForeColor.RGB)
oshp.Tags.Add "LNWT", CStr(oshp.Line.Weight)
oshp.Fill.ForeColor.RGB = RGB(255, 0, 0)
oshp.Line.Weight = 4
Else
oshp.Line.Weight = CLng(oshp.Tags("LNWT"))
oshp.Fill.ForeColor.RGB = CLng(oshp.Tags("COL"))
oshp.Tags.Delete ("COL")
oshp.Tags.Delete ("LNWT")
End If
End Sub

[pptSam]

Hello Cosmo!

Thank you very much for your input: I changed the script and use the "direct" reference already set (shp) the way you proposed, and - IT WORKS!:rotlaugh:

Good question, why I chose the complicated way I did - one of this "blind" moments I guess...

So, the script is running again although I still not know, why it stopped running, when I changed to version 2007 on that other system.

Thank's a lot!

[pptSam]

Hello John

I haven't had the time yet to try your solution, but I will post my experience as soon as I have tried it...

So, also many thanks to you...

[pptSam]

Hello John

your approach is also very nice and works in my tests! So, once again - thank you very much for the support...

Sam