Custom Additional Cell Actions in Excel 2010
I'd like to extend the MS Excel 2010 by adding some more "Additional Cell Actions". (accessible via cell right-click > Additional Cell Actions). Sp开发者_运维百科ecifically, I'd like Excel to:
- recognize five-to-eight digit numbers as Part Numbers with action: "Open URL to technical docs"
- recognize string "OR ## #####" (# for digit) as Order Reference with actions: "Open spec file" and "Open material file" (both Excel files located at specified paths in the intranet)
Now, I have no idea how to program this. I suspect that some XML snippet is needed and probably some VB code too. VB code wouldn't be a problem - I have macros doing those functionalities done for Excel 2003 - but I have no idea where to place it.
Please give me some pointers, I've asked Google but can't get the answer, seems that "Additional Actions" is pretty common phrase :)
This can be achieved by adding a right click event handler to the workbook
In the Workbook module add this code
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim cBut As CommandBarButton
Dim v As Variant
On Error Resume Next
v = Target
' Remove any previously added menu items
Application.CommandBars("Cell").Controls("Open URL to technical docs").Delete
Application.CommandBars("Cell").Controls("Open material file").Delete
' save cell value for use by called macro
CellValue = v
' If cell matches criteria add menu item and set macro to call on click
If IsNumeric(v) Then
If v >= 10000 And v <= 99999999 Then
Set cBut = Application.CommandBars("Cell").Controls.Add(Temporary:=True)
With cBut
.Caption = "Open URL to technical docs"
.Style = msoButtonCaption
.OnAction = "OpenRef"
End With
End If
ElseIf v Like "OR ## #####" Then
Set cBut = Application.CommandBars("Cell").Controls.Add(Temporary:=True)
With cBut
.Caption = "Open material file"
.Style = msoButtonCaption
.OnAction = "OpenMat"
End With
End If
End Sub
In a standard module add this code
Public CellValue As Variant
' replace MsgBox code with your logic to open files
Sub OpenRef()
MsgBox "Open Reference Doc code here for " & CellValue
End Sub
Sub OpenMat()
MsgBox "Open Material File code here for " & CellValue
End Sub
精彩评论