数据验证输入消息解决方法255 char

时间:2015-07-21 13:20:12

标签: excel excel-vba textbox validation vba

我正在尝试为jqXHR.responseText创建一个解决方法,因为我的输入消息超过255个字符。
我尝试了http://contextures.com/xlDataVal12.html,但Data Validation Input Message已修复。我需要文本框或标签随所选单元格一起移动。

在下图中,您可以看到问题。我们无法在输入框中显示整个消息。

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

1 个答案:

答案 0 :(得分:1)

使用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