具體程式碼如下：

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 "結束過程