Excel VBA右键设置单元格有效性下拉框 - Excel VBA开发

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) '
On Error Resume Next '忽略错误
Application.ScreenUpdating = False '关闭屏幕刷新
If Target.Column = 2 And Target.Count = 1 Then '判断是否在B列右击鼠标
Application.CommandBars("CELL").Enabled = False '如果是，关闭鼠标右击弹出菜单
md = Join(Application.Transpose(Sheets("数据").Range("D6:D1000")), ",")
With Selection.Validation '对所单击的单元格，创建数据有效性
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=md '"Hello,Very good,Every day,898,0044,44944"
.IgnoreBlank = True '设置单元格允许空值
.InCellDropdown = True '提供下拉列标
.InputTitle = "友情提示" '提示标题
.ErrorTitle = "" '出错提示，可以自己添加
.InputMessage = "你在此单元格，可以选择一个费用类别。也可以自己添加实际发生的新类别。但必须是符合规定的类别。" '提示语句
.ErrorMessage = "" '出现非有效性中内容时的提示。可以自己添加
.IMEMode = xlIMEModeOff '关闭输入法
.ShowInput = True '如果用户输入了无效数据,显示数据有效性检查输入消息
.Show
Error = False '如果用户输入了无效数据,显示错误消息，
End With
Else '判断不在B列右击鼠标，则打开鼠标右击弹出菜单
Application.CommandBars("CELL").Enabled = True
End If '结束判断
Application.ScreenUpdating = True '恢复屏幕刷新
End Sub '结束过程

联系人：	王先生
Email：	18449932@qq.com
QQ：	18449932
微博：	officecn01

联系人：

王先生

Email：

18449932@qq.com

QQ：

18449932

微博：

officecn01