Actually I know how to pop-up a message box through macro. But, I need help in displaying the message box in an interactive manner, like JQuery pop-ups used in websites. Could any one help me in creating the macro for displaying interactive cell on hover/ on click.
Finally I found it... The macro given below does the effect of popping up :)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'On Error GoTo errorhandler
For Each Sh In ActiveSheet.Shapes
If Sh.AutoShapeType = msoShapeRectangle Then
Sh.Delete
End If
Next
If Target.Cells.Count = 1 Then
'
' strcol = ActiveSheet.TextBox2.Text
' arraycol = Split(strcol, ",")
flagcol = True
' For zx = 0 To UBound(arraycol)
' If Target.Column = arraycol(zx) Then
' flagcol = True
' End If
' Next zx
If flagcol = True And Target.Value "" And Target.Row > 2 And Target.Column > 4 And Target.Column < 10 Then
Dim array1(23)
array1(0) = 3
array1(1) = 5
array1(2) = 7
array1(3) = 9
array1(4) = 10
array1(5) = 11
array1(6) = 12
array1(7) = 13
array1(8) = 14
array1(9) = 18
array1(10) = 23
array1(11) = 25
array1(12) = 26
array1(13) = 29
array1(14) = 30
array1(15) = 31
array1(16) = 32
array1(17) = 41
array1(18) = 46
array1(19) = 49
array1(20) = 53
array1(21) = 54
array1(22) = 55
''' Application.DisplayFormulaBar = False
top1 = 0
For i = 1 To Target.Row
'If Rows(i).EntireRow.Hidden = True Then Count = Count + Rows(1).Height
If Rows(i).EntireRow.Hidden = False Then top1 = top1 + Rows(i).Height
Next
side1 = 0
For i = 1 To Target.Column - 2
'If Rows(i).EntireRow.Hidden = True Then Count = Count + Rows(1).Height
If Columns(i).EntireColumn.Hidden = False Then side1 = side1 + Columns(i).Width
Next
arraypar = Split(Target.Value, Chr(13))
height1 = 0
For vc = 0 To UBound(arraypar)
height1 = height1 + 73 * 0.25 * (Len(arraypar(vc)) / 100) + 2 * 0.25 * 73
Next vc
'Top = Target.Row * Rows(Target.Row).RowHeight
' Top = 3 + ActiveWindow.ScrollRow
' ActiveWindow.SmallScroll Down:=30
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, side1, top1, 599.25, height1).Select
'' For i = 0 To Int(Len(Target.Value) / 255)
'' Selection.Text = Target.Value
Selection.Characters(Selection.Characters.Count).Insert Target.Value
'' Next
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 165, 0)
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 165, 0)
Selection.ShapeRange.Fill.Transparency = 0.05
Selection.ShapeRange.Line.Weight = 4.5
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineThickThin
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
'Selection.Paste
' With Selection.Characters(Start:=1, Length:=4).Font
' .Name = "Monotype Corsiva"
' .FontStyle = "Bold"
' .Size = 10
' .Strikethrough = False
' .Superscript = False
' .Subscript = False
' .OutlineFont = False
' .Shadow = False
' .Underline = xlUnderlineStyleNone
' .ColorIndex = xlAutomatic
' End With
' array2 = Split(ActiveSheet.TextBox1.Text, ",")
Start1 = -2
' For i = 0 To UBound(array2)
' Start1 = -Len(Trim(array2(i))) + 1
' Do While 1 = 1
' Start1 = InStr(Start1 + Len(Trim(array2(i))), ActiveCell.Value, Trim(array2(i)), vbTextCompare)
' If Start1 > 0 Then
' If i < 22 Then
' With Selection.Characters(Start:=Start1, Length:=Len(Trim(array2(i))) + 1).Font
' .Name = "Monotype Corsiva"
' .FontStyle = "Bold"
' .Size = 12
' .Strikethrough = False
' .Superscript = False
' .Subscript = False
' .OutlineFont = False
' .Shadow = False
' .Underline = xlUnderlineStyleNone
' .ColorIndex = array1(i)
' End With
' Else
' With Selection.Characters(Start:=Start1, Length:=Len(Trim(array2(i)))).Font
' .Name = "Monotype Corsiva"
' .FontStyle = "Bold"
' .Size = 12
' .Strikethrough = False
' .Superscript = False
' .Subscript = False
' .OutlineFont = False
' .Shadow = False
' .Underline = xlUnderlineStyleNone
' .ColorIndex = array1(i - 22)
' End With
'
' End If
'
'
' Else
' Exit Do
'
' End If
' Loop
' Next i
Target.Select
'Sheet1.TextBox1.Characters(2, 5).Font.FontStyle = "Bold"
Else
Application.DisplayFormulaBar = True
End If
End If
errorhandler:
End Sub
It is good that you placed the answer when you found it for the benefit of other researchers.
But I think you can make it without macros through data validation function.
Sure @Balamurugan, I made a sample for you, as you have to tell the user that a cell should contain time that is 7:00 or more.
I attached 2 numbered pictures of several screen captures.
- Badges
- Science topic