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

Question

输入消息数据验证限制为 255 个字符和 9 行。如何用文本框替换它。这有没有可能？ 这是我的代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    调暗为范围
    Dim arr, cellVal 作为变体
    设置 rng = Range("A1:A10")
    arr = rng.Value
    If Not Intersect(Target, rng) 什么都不是

    对于 i = 1 到 rng.Rows.Count
        对于 j = 1 到 rng.Columns.Count
            cellVal = arr(i, j)
            选择案例 cellVal
              案例是=“A”
                  rng(i, j).Validation.InputMessage = "介绍和历史：" & vbTab & vbCrLf & _
                “一只眼睛或两只眼睛” & vbTab & vbCrLf & _
                “坚韧不拔的感觉/瘙痒与疼痛” & vbTab & vbCrLf & _
                “畏光” & vbTab & vbCrLf & _
                “视觉变化” & vbTab & vbCrLf & _
                "放电存在" & vbTab & vbCrLf & _
                “伤害” & vbTab & vbCrLf & _
                "异物" & vbTab & vbCrLf & _
                “过敏史或花粉热”和 vbTab
              案例是=“B”
                  rng(i, j).Validation.InputMessage = TextBox1.Text
              案例是=“C”
                  rng(i, j).Validation.InputMessage = "胡萝卜"
              其他情况
                  rng(i, j).Validation.InputMessage = "别的东西"
            结束选择
        下一个 j
    接下来我
    万一
结束子

案例“A”显示了数据验证消息的限制。我想用 TextBox1 替换它，如案例“B”所示。请让我知道是否可能。 问候 托马索

Answer 1

您可以通过像这样使各种文本框可见来模仿该行为：

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

然后编写一个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

你应该完成了吗？！？

（谢天谢地从https://www.lipsum.com/窃取的TextBox内容）