我正在尝试为< code >数据验证输入消息创建一个解决方法,因为我的输入消息超过了255个字符。< br >我试过http://contextures.com/xlDataVal12.html,但是< code >文本框是固定的。我需要文本框或标签与选定的单元格一起移动。
在下图中,您可以看到问题。我们无法在输入框中显示整个消息。
1.http://img5013.photobox.co.uk/42779160c8143d2fcab8c396d411e8b621181c1be9f1a01fb62e272d26debaf4b53f7657.jpg
使用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