how to programmatically move or resize validation message box in Excel VBA

Question

It's possible to resize or move the validation cell message box?

When a worksheet cell has some validation rules with messages, It's possible to resize or move (with VBA code) the validation cell message box, in order to not cover other cells?

Thanks.

Currently my messages with very large and cover important cells

Answer 1

No, it is not possible. The way out of this is to create a User Form. Have a look a the Insert menu in VBE.

Answer 2

After a few hours of working on the matter, I want to propose a solution to my own question.

For this I have based on the solution proposed in another forum, although with another purpose. Thanks to authors. I sincerely hope you find it useful

Proposed solution in another forum

Here is my modified code:

Option Explicit

    Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent _
    As Long, _
    ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

    Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent _
    As Long) As Long

    Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

    Type POINTAPI
    x As Long
    Y As Long
    End Type

    Dim lngCurPos As POINTAPI
    Dim TimerOn As Boolean
    Dim TimerId As Long
    Dim newRange As Range
    Dim oldRange As Range

    Dim oToolTipHelp As OLEObject   'A label working as tool tip

    Dim wb As Workbook
    Dim ws As Worksheet

    Sub StartTimer()

        'Assign values to ws and wb, used in many parts
        Set wb = ThisWorkbook
        Set ws = wb.Sheets("CALCULOS")

        If Not TimerOn Then

            TimerId = SetTimer(0, 0, 0.01, AddressOf TimerProc)
            TimerOn = True

        Else

            MsgBox "Timer already On !", vbInformation
        End If

    End Sub

    '---------------------------------------------------------------------------------------
    ' Procedure : GetToolTipHelp
    ' Author    : INGENIERO
    ' Date      : 30/07/2019
    ' Purpose   : Creates LblToolTipHelp if does not exist
    '---------------------------------------------------------------------------------------
    '
    Function GetToolTipHelp(ws As Worksheet) As Object

        Dim shpObj As OLEObject

        For Each shpObj In ws.OLEObjects

            If shpObj.Name = "LblToolTipHelp" Then

                Set GetToolTipHelp = shpObj

                Exit Function

            End If

        Next shpObj

        'This part is only for my program. Measures are only for me.

        Dim lTop As Single
        Dim lLeft As Single
        Dim lWidth As Single
        Dim lHeight As Single

        lTop = ws.Cells(27, 8).top
        lLeft = ws.Cells(27, 8).left
        lWidth = ws.Cells(1, 18).left - ws.Cells(1, 8).left
        lHeight = ws.Cells(31, 1).top - ws.Cells(27, 1).top

        'Creates Help Label if does not exist
         ws.OLEObjects.Add(ClassType:="Forms.Label.1", Link:=False, _
            DisplayAsIcon:=False, left:=lLeft, _
                                    top:=lTop, _
                                    width:=lWidth, _
                                    height:=lHeight) _
                                    .Name = "LblToolTipHelp"

        With ws.OLEObjects("LblToolTipHelp")
            .Object.BackColor = RGB(255, 255, 192)
        End With

        Set GetToolTipHelp = shpObj

    End Function

    Sub TimerProc()

        If oToolTipHelp Is Nothing Then
        'Creates ToolTip if does not exist

            Set oToolTipHelp = GetToolTipHelp(ws)

        End If

        If oldRange Is Nothing Then

            Set oldRange = ws.Cells(1, 1) 'First set of oldRange
            Set newRange = ws.Cells(1, 1) 'First set of newRange

        Else

            GetCursorPos lngCurPos

            On Error Resume Next    'oldRange isn't set at first time

            Set newRange = ActiveWindow.RangeFromPoint(lngCurPos.x, lngCurPos.Y)

            If newRange Is Nothing Then

                Exit Sub

            Else

                If newRange.Address <> oldRange.Address Then

                    Set oldRange = newRange

                End If

            End If

        End If

        ChangeToolTip

    End Sub

    Sub StopTimer()

        If TimerOn Then

            KillTimer 0, TimerId

            TimerOn = False

        Else

            MsgBox "Timer already Off", vbInformation

        End If

    End Sub

    Sub ChangeToolTip()                        

        ws.OLEObjects("LblToolTipHelp").Object.Caption = newRange.Row & "," & newRange.Column

    End Sub

On ChangeToolTip Sub, you can post your own messages