Adding screen tip to a beam shape ??

[keldsor]

I have some beams (shapes) all over e worksheep.

I want a screen tip to be visible when the user hoover over each of the beams.

I've inserted the beams with this code:

    Set B = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, _
                                            leftSpace + DateDiff("d", "01-01-" & stYear, fraDato) / totalDates * yearSpace * (DateDiff("y", stYear, eYear) + 1), _
                                            Ypos, _
                                            leftSpace + DateDiff("d", "01-01-" & stYear, tilDato) / totalDates * yearSpace * (DateDiff("y", stYear, eYear) + 1), _
                                            Ypos)
    With B
        .Name = beamNavn
        .OnAction = "showBOiDInAccess"
        .Line.ForeColor.RGB = ColorConstants.vbRed
        .Line.Weight = 3       ' tykkelse af bjælken
    End With
    makeScreenTip B, tip
    Set B = Nothing

and the tip with this (NOT WORKING !!!)

Private Sub makeScreenTip(eD As Shape, tip As String)
    ' inserts a tip screenTip on the eD beam
'    With eD.TextFrame.Characters
'        .Font.Color = vbBlack
'        .Text = "    " & tip
'        ActiveSheet.Hyperlinks.Add eD, "", "", ScreenTip:=.Characters.Text
'    End With
End Sub

How can I add the TIP to the beams ?

 

[MickG]

Something like this:-

[COLOR="Navy"]Sub[/COLOR] MG07Jan25
[COLOR="Navy"]Dim[/COLOR] B [COLOR="Navy"]As[/COLOR] Shape
[COLOR="Navy"]Set[/COLOR] B = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 137.4, 166.8, 232.2, 32.4)
makeScreenTip B, "Hello"
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Private [COLOR="Navy"]Sub[/COLOR] makeScreenTip(eD [COLOR="Navy"]As[/COLOR] Object, tip [COLOR="Navy"]As[/COLOR] String)
    '[COLOR="Green"][B] inserts a tip screenTip on the eD beam[/B][/COLOR]
    [COLOR="Navy"]With[/COLOR] eD.TextFrame.Characters
        .Font.Color = vbBlack
       .Text = "    " & tip
    [COLOR="Navy"]End[/COLOR] With
        ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Shapes(eD.Name), Address:="", ScreenTip:=tip
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[keldsor]

Something like this:-

[COLOR=Navy]Sub[/COLOR] MG07Jan25
[COLOR=Navy]Dim[/COLOR] B [COLOR=Navy]As[/COLOR] Shape
[COLOR=Navy]Set[/COLOR] B = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 137.4, 166.8, 232.2, 32.4)
makeScreenTip B, "Hello"
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Private [COLOR=Navy]Sub[/COLOR] makeScreenTip(eD [COLOR=Navy]As[/COLOR] Object, tip [COLOR=Navy]As[/COLOR] String)
    '[COLOR=Green][B] inserts a tip screenTip on the eD beam[/B][/COLOR]
    [COLOR=Navy]With[/COLOR] eD.TextFrame.Characters
        .Font.Color = vbBlack
       .Text = "    " & tip
    [COLOR=Navy]End[/COLOR] With
        ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Shapes(eD.Name), Address:="", ScreenTip:=tip
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

No ... it doesn't work ;-(

It seems not to bee "connected" to my beam - you just make a new shape I think.

If I run your changes Sub I get this:

Run time error 438
marked in
With eD.TextFrame.Characters

that was myoriginal problem too !


BTW: why did I NOT get an e-mail advice for your reply ?

 

[MickG]

It works for me ,but that doesn't help you !!
I would concentrate on the just the screen tip portion of code,and see if you can get that to work, you should be able to record a macro for the Textframe Fonts and Text parts.
Try this shortened code see if that works

[COLOR="Navy"]Sub[/COLOR] MG08Jan28
[COLOR="Navy"]Dim[/COLOR] B [COLOR="Navy"]As[/COLOR] Shape
[COLOR="Navy"]Set[/COLOR] B = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 137.4, 166.8, 232.2, 32.4)
ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Shapes(B.Name), Address:="", ScreenTip:="My Text"


[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick



Ps:-No idea about the Email perhaps Contact Mr.Excel

 

[keldsor]

I wonder why it doesn't work ...

Now I've changed this line to the same you have:

Set B = ActiveSheet.Shapes.AddConnector(msoShapeRectangle, _
leftSpace + DateDiff("d", "01-01-" & stYear, fraDato) / totalDates * yearSpace * (DateDiff("y", stYear, eYear) + 1), _
Ypos, _
leftSpace + DateDiff("d", "01-01-" & stYear, tilDato) / totalDates * yearSpace * (DateDiff("y", stYear, eYear) + 1), _
Ypos)

but still I get the

Run time error 438
Object doesn't support this property or method

in this line in the Sub:

Private Sub makeScreenTip(eD As Shape, tip As String)
' inserts a tip screenTip on the eD beam
With eD.TextFrame.Characters <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
.Font.Color = vbBlack
.Text = " " & tip
End With
ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Shapes(eD.Name), Address:="", ScreenTip:=tip
End Sub

and it presents these names if I try to type it again ... ???