Apply CommentBox to objects?

[CLR]

Hi All.........
Could someone please tell me if it's possible through VBA to apply a pop-up
CommentBox, or a close simulation, to things other than a cell.....such as a
TextBox, or DrawingObject, or image? Pop-up to appear upon mouse-over or
selection of the object.

TIA
Vaya con Dios,
Chuck, CABGx3

 

[Joel]

Always, Always, Always try first and see if a learning marcro will help you
with your VBA problems. Changing text in any object can always be done with
a VBA macro. The trick is finding the object. Therefore, a pup up box where
you enter the text string can always be copied to the object.

finding object can be done with statements like

For each Myobject in Worksheets("Sheet1").object

next Myobject

 

[CLR]

Thanks for taking the time to respond Joel.......but either you missed the
point, or I did........'cause I still don't know the answer to my question.
I'm looking for a way to apply a pop-up comment-type box to a drawing object
or image whereby as I mouse over it, or select it, the pop-up will appear.

Thanks anyway,
Vaya con Dios,
Chuck, CABGx3

 

[Joel]

Additional comments. Here is code that I used. I had a problem that the
chart wizrd only allows you to select a worksheet where the chart is created.
Not a position. I had over 100 charts that I was putting on one worksheet.
The chart wizard was putting all the chart on top of each other. So this
routine took all the charts and arranged them so they weren't on top of each
other. I used the S/N which was in the tet header on each chart to arrange
the charts.


For Each AllCharts In Worksheets(TemperatureSheetName).Shapes

ChartName = "Temp Chart" + Str(SerialNumber)

If InStr(AllCharts.Name, "Temp Chart") = 0 Then
AllCharts.Name = ChartName

Worksheets(TemperatureSheetName).ChartObjects(ChartName).Activate
ActiveChart.Axes(xlValue).Select
With ActiveChart.Axes(xlValue)
.MinimumScale = 90
.MaximumScale = 160
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With

Worksheets(TemperatureSheetName).Shapes(ChartName).Top = _
Worksheets(TemperatureSheetName). _
Rows((ChartRowOffset * (ModChartNumber)) + 1).Top
Worksheets(TemperatureSheetName).Shapes(ChartName).Left = _
Worksheets(TemperatureSheetName).Columns(MyColumnOffset).Left
End If

Next AllCharts

End If

 

[Bob Phillips]

Put the following code in a standard code module (making it
available to the whole workbook).

'------------- bas module ------------------------

Option Explicit

Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long

Declare Function GetSysColor Lib "user32" _
(ByVal nIndex As Long) As Long

Public Function CreateToolTipLabel(oHostOLE As Object, _
sTTLText As String) As Boolean
Dim oToolTipLbl As OLEObject
Dim oOLE As OLEObject

Const SM_CXSCREEN = 0
Const COLOR_INFOTEXT = 23
Const COLOR_INFOBK = 24
Const COLOR_WINDOWFRAME = 6

Application.ScreenUpdating = False

For Each oOLE In ActiveSheet.OLEObjects
If oOLE.Name = "TTL" Then oOLE.Delete
Next oOLE

'create a label control...
Set oToolTipLbl = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Label.1")

'...and format it to look as a ToolTipWindow
With oToolTipLbl
.Top = oHostOLE.Top + oHostOLE.Height - 10
.Left = oHostOLE.Left + oHostOLE.Width - 10
.Object.Caption = sTTLText
.Object.Font.Size = 8
.Object.BackColor = GetSysColor(COLOR_INFOBK)
.Object.BackStyle = 1
.Object.BorderColor = GetSysColor(COLOR_WINDOWFRAME)
.Object.BorderStyle = 1
.Object.ForeColor = GetSysColor(COLOR_INFOTEXT)
.Object.TextAlign = 1
.Object.AutoSize = False
.Width = GetSystemMetrics(SM_CXSCREEN)
.Object.AutoSize = True
.Width = .Width + 2
.Height = .Height + 2
.Name = "TTL"
End With
DoEvents
Application.ScreenUpdating = True

'delete the tooltip window after 5 secs
Application.OnTime Now() + TimeValue("00:00:05"), "DeleteToolTipLabels"

End Function

Public Sub DeleteToolTipLabels()
Dim oToolTipLbl As OLEObject
For Each oToolTipLbl In ActiveSheet.OLEObjects
If oToolTipLbl.Name = "TTL" Then oToolTipLbl.Delete
Next oToolTipLbl
End Sub

'------------end of bas module -------------


Then in the code module for the sheet that has the control, add some
mousedown event code. To get to this module, right-click on the sheet name
tab, and selecw code (or double-click on the sheet name from within the VB
IDE). Here is an example of how to call it, assuming that the textbox
is calle TextBox1

Private Sub TextBox1_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
Dim oTTL As OLEObject
Dim fTTL As Boolean

For Each oTTL In ActiveSheet.OLEObjects
fTTL = oTTL.Name = "TTL"
Next oTTL

If Not fTTL Then
CreateToolTipLabel TextBox1, "ToolTip Label"
End If

End Sub





--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[CLR]

Hi Bob.........thanks much for that. I had to change one line
from
CreateToolTipLabel TextBox1, "ToolTip Label"
to
CreateToolTipLabel Shapes("Text Box 1"), "ToolTip Label"
to get that part to work in my Excel97,...the ToolTip pops up, and goes away
after the timeout when I run this line alone in a small macro........... but
for the life of me, I can't make it work with the MouseMove thing or by just
selecting the object.......

Might I be missing a reference or something or does that MouseMove code only
work in newer Excel versions?
Vaya con Dios,
Chuck, CABGx3

 

[Bob Phillips]

The code I gave was aimed at text boxes from the Control Toolbox Chuck, not
shapes. There is no events for drawing shapes. Can you use control toolbox
textboxes?

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[CLR]

Thanks for the info Bob........no, can't live with Control Toolbox text
boxes, I want to do shapes.

Can you tell me if there is any way to determine if a shape is selected or
not.
Something like,
If shapes("Text Box 1").select = true then

Vaya con Dios,
Chuck, CABGx3

 

[Bob Phillips]

Maybe something like

If Typename(Selection) = "TextBox") Then
If Selection.Name = "Text Box 1" Then
etc.

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[CLR]

Just tried both, no joy yet.........will fool with it tomorrow

Thanks,
Vaya con Dios,
Chuck, CABGx3