AW: Hinweis...
04.08.2008 21:23:05
Ramses
Hallo Kurt
Also schön,... extra für Dich :-)
Option Explicit
Public TempTextName As String
Public txtFrame As Boolean
Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'(C) Ramses
'Extra für Kurt ohne Select :-)
'Eigenes Tooltip für einen Commandbutton definieren
Dim topCorner As Double, leftCornerTxt As Double, bottomCornerTxt As Double
Dim oldCell As Range
Dim myTb As Shape
With Me.CommandButton1
'Infotip erst einblenden, bzw. wieder ausblenden, wenn Mauscourser
'einen Bereich von 3 Points von den äusseren Rändern des Commandnuttons
'überschreitet
If Y > 3 And Y < .Height - 3 And X > 3 And X < .Width - 3 Then
If txtFrame = True Then Exit Sub
leftCornerTxt = ActiveSheet.CommandButton1.Left + ActiveSheet.CommandButton1.Width
bottomCornerTxt = ActiveSheet.CommandButton1.Top + ActiveSheet.CommandButton1.Height
Set myTb = ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, leftCornerTxt, bottomCornerTxt, 0#, 0#)
With myTb
.TextFrame.AutoSize = msoTrue
With .OLEFormat.Object
.Text = "Dein Texthinweis:" & Chr$(10) & "(C) Ramses" & Chr$(10) & "Dein Text zur Anzeige"
.Font.Name = "Arial"
.Font.FontStyle = "Standard"
.Font.Size = 10
.ShapeRange.Fill.ForeColor.SchemeColor = 43
.ShapeRange.Fill.Visible = msoTrue
.ShapeRange.Fill.Solid
.ShapeRange.Line.Weight = 1#
.ShapeRange.Line.Visible = msoTrue
.ShapeRange.Line.Style = msoLineSingle
.ShapeRange.Line.ForeColor.SchemeColor = 64
End With
TempTextName = .Name
End With
txtFrame = True
Else
On Error Resume Next
With ActiveSheet.Shapes(TempTextName)
.Delete
End With
txtFrame = False
End If
End With
Set myTb = Nothing
End Sub
Gruss Rainer