office交流網--QQ交流群號

Access培訓群:792054000         Excel免費交流群群:686050929          Outlook交流群:221378704    

Word交流群:218156588             PPT交流群:324131555

Excel VBA右鍵設置單元格有效性下拉框

2020-05-01 08:00:00
gufengaoyue
轉貼
257
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 '結束過程
分享