View Full Version : How to pull data from a Sheet to create a Context Menu? How to combine two VBA codes?

08-06-2019, 02:35 PM
I find Add-in on Ron de Bruin's (https://www.rondebruin.nl/win/s2/win004.htm) page, there the whole thing pulled together with realized data Sheet.
Direct link to download Workbook (https://my-files.ru/xrb05k) (and also file attached).
The fact is that slowly becoming more buttons and this is difficult to mess around. Therefore, I liked the version of Ron de Bruin (everything is clear there).

All this I want to fasten on the cursor (the Context Menu will be called after a click on Ctrl+N). I already have a full working VBA code (it is only for `Notes`, POPs up if the cell thereof). The problem is that I do not know how to combine (the whole day was carried nothing happens)?
!! Help from here to shift the desired lines of code in the Add-in from Ron de Bruin (With the ability to insert My icons.).

Application.OnKey "^{n}", CodeName & ".ContextMenu"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.OnKey "^{n}"
End Sub

Private Sub ContextMenu()
If ActiveCell Is Nothing Then Exit Sub
If ActiveCell.Comment Is Nothing Then Exit Sub

On Error Resume Next 'Можно и без оного, но тогда с перебором(циклом) CommandBars.
Dim cb As CommandBar
Set cb = Application.CommandBars("vbaPopup")
If cb Is Nothing Then CreateContextMenu

End Sub

Private Sub CreateContextMenu()
Dim a1_icon, a1_file, a2, a3, i&, m$, p$, f$: m = CodeName & ".": p = Path & "\Image"
a1_icon = Array(76, 72, 178, 53)
a1_file = Array("NoteZoom_200x110.jpg", "NoteZoom_600x400.jpg", "Full Screen.jpg", "NoteZoom_InputBox.jpg", "Copy Text.jpg")
a2 = Array("NoteZoom 200x110", "NoteZoom 600x400", "Note ", "NoteZoom InputBox", "Скопировать текст примечания")
a3 = Array("NoteZoom1", "NoteZoom2", "NoteZoom3", "NoteZoom_InputBox", "NoteTextToClipboard")

With Application.CommandBars.Add("vbaPopup", msoBarPopup, , True) 'Можно и НЕ делать контекстное меню временным.
For i = 0 To UBound(a1_file) 'Ubound(a1_ico)
With .Controls.Add
f = p & a1_file(i)
If Len(Dir(f)) Then
.Picture = LoadPicture(f)
.FaceId = a1_icon(i) 'Если файл не найден, то иконка (но это необязательно).
End If
.Caption = a2(i)
.OnAction = m & a3(i)
End With
End With

Subs are runnable for .OnAction removed I think the combination of not need to the same in the add-in from Ron de Bruin has macros for example.