Обходной путь для входного сообщения проверки данных 255 символов

Я пытаюсь найти обходной путь для Data Validation Input Message, так как мое входное сообщение содержит более 255 символов.
Я пробовал http://contextures.com/xlDataVal12.html, но text box исправлено. Мне нужно, чтобы текстовое поле или метка перемещались вместе с выбранной ячейкой.

На изображении ниже вы можете увидеть проблему. Мы не можем отобразить все сообщение в поле ввода.

http://img5013.photobox.co.uk/42779160c8143d2fcab8c396d411e8b621181c1be9f1a01fb62e272d26debaf4b53f7657.jpg


validation excel vba textbox
person Niclas    schedule 21.07.2015    source источник

Ответы (1)


arrow_upward
1
arrow_downward

Используя код Contextures, вам необходимо установить для свойств .Top и .Left фигуры те же свойства ячейки. Вот переписанный код, который перемещает текстовое поле рядом с ячейкой.

' Developed by Contextures Inc.
' www.contextures.com
' modified by Dick Kusleika 7/21/2015
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim sTitle As String
    Dim sMsg As String
    Dim sMsgAdd As String
    Dim tbxTemp As Shape
    Dim lDVType As Long
    Dim lRowMsg As Long
    Dim ws As Worksheet

    Application.EnableEvents = False

    Set ws = Target.Parent
    Set tbxTemp = ws.Shapes("txtInputMsg")

    On Error Resume Next
        lDVType = 0
        lDVType = Target.Validation.Type
    On Error GoTo errHandler

    If lDVType = 0 Then
        tbxTemp.TextFrame.Characters.Text = vbNullString
        tbxTemp.Visible = msoFalse
    Else
        If Len(Target.Validation.InputTitle) > 0 Or Len(Target.Validation.InputMessage) > 0 Then

            sTitle = Target.Validation.InputTitle & vbLf

            On Error Resume Next
                lRowMsg = 0
                lRowMsg = Application.WorksheetFunction.Match(Target.Validation.InputTitle, Sheets("MsgText").Columns(1), 0)
                If lRowMsg > 0 Then
                    sMsgAdd = Me.Parent.Sheets("MsgText").Cells(lRowMsg, 2).Value
                End If
            On Error GoTo errHandler

            sMsg = Target.Validation.InputMessage
            With tbxTemp.TextFrame
                .Characters.Text = sTitle & sMsg & vbLf & sMsgAdd
                .Characters.Font.Bold = False
                .Characters(1, Len(sTitle)).Font.Bold = True
            End With
            tbxTemp.Top = Target.Offset(1, 1).Top
            tbxTemp.Left = Target.Offset(1, 1).Left
            tbxTemp.Visible = msoTrue
            tbxTemp.ZOrder msoBringToFront
        Else
            tbxTemp.TextFrame.Characters.Text = vbNullString
            tbxTemp.Visible = msoFalse
        End If
    End If

errHandler:
    Application.EnableEvents = True

End Sub
person Dick Kusleika    schedule 21.07.2015
comment
Привет @ Дик, это работает как шарм !! Большое спасибо. Не могли бы вы просто помочь мне вывести текстовое поле на передний план, чтобы оно отображалось в тексте. Действительно ценю это! - person Niclas; 21.07.2015
comment
В код добавлена ​​строка zOrder, которая выводит текстовое поле на передний план. Автоподгонка немного сложнее. Вы можете исправить высоту и попытаться отрегулировать ширину в зависимости от количества символов .Width = .TextFrame.Characters.Count / 5 * 6:.Height = 100. Вам придется поиграть с цифрами, чтобы увидеть, что работает. - person Dick Kusleika; 21.07.2015
comment
Бах, Excel уже подумал об этом (и вы, вероятно, тоже). Щелкните правой кнопкой мыши текстовое поле, выберите «Свойства», выберите «Текстовое поле» и установите флажок Resize to fit text. - person Dick Kusleika; 21.07.2015