首页 文章

如何使用文本框替换数据验证输入消息

提问于
浏览
0

输入消息数据验证限制为255个字符和9行 . 如何用文本框替换它 . 可能吗?在这里你去我的代码:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim arr, cellVal As Variant
    Set rng = Range("A1:A10")
    arr = rng.Value
    If Not Intersect(Target, rng) Is Nothing Then

    For i = 1 To rng.Rows.Count
        For j = 1 To rng.Columns.Count
            cellVal = arr(i, j)
            Select Case cellVal
              Case Is = "A"
                  rng(i, j).Validation.InputMessage = "Presentation and history:" & vbTab & vbCrLf & _
                "One eye or both eyes" & vbTab & vbCrLf & _
                "Gritty sensation/itch versus pain" & vbTab & vbCrLf & _
                "Photophobia" & vbTab & vbCrLf & _
                "Visual change" & vbTab & vbCrLf & _
                "Discharge present" & vbTab & vbCrLf & _
                "Injury" & vbTab & vbCrLf & _
                "Foreign body" & vbTab & vbCrLf & _
                "History of allergy or hay fever" & vbTab
              Case Is = "B"
                  rng(i, j).Validation.InputMessage = TextBox1.Text
              Case Is = "C"
                  rng(i, j).Validation.InputMessage = "Carrot"
              Case Else
                  rng(i, j).Validation.InputMessage = "Something   else"
            End Select
        Next j
    Next i
    End If
End Sub

案例“A”显示数据验证消息的限制 . 我想用TextBox1替换它,如案例“B”所示 . 如果有可能请告诉我 . 关心Tommaso

1 回答

  • 1

    您可以通过使各种文本框可见来模仿行为:

    首先创建一个数字或普通的文本框 - 使用多种字体,字体大小,颜色,铃声和口哨

    create textboxes

    然后写一个 Selection_Change 触发器...非常类似于你所做的(注意插入菜单中的文本框是 Shapes()

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim MyTB As Shape
        ' hide all boxes
        ActiveSheet.Shapes("TextBox 1").Visible = msoFalse
        ActiveSheet.Shapes("TextBox 2").Visible = msoFalse
        ActiveSheet.Shapes("TextBox 3").Visible = msoFalse
    
        ' working on B1:B10 in order not to disturb data validation in A1:A10
        If Not Intersect(Target, [B1:B10]) Is Nothing Then
    
            ' assign correct TextBox to MyTB
            Select Case Target.Value
                Case "A", "a"
                    Set MyTB = ActiveSheet.Shapes("TextBox 1")
                Case "B", "b"
                    Set MyTB = ActiveSheet.Shapes("TextBox 2")
                Case Else
                    Set MyTB = ActiveSheet.Shapes("TextBox 3")
            End Select
    
            ' position MyTB one cell right/down from Cursor (Target) and make visible
            MyTB.Left = Target(1, 2).Left
            MyTB.Top = Target(2, 2).Top
            MyTB.Visible = msoTrue
    
        End If
    End Sub
    

    你应该完成吗?!?

    enter image description here

    (感谢从https://www.lipsum.com/偷来的TextBox内容)

相关问题