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