Eccone il codice:
Public Sub showMenu()
Dim cbr As CommandBar
Dim ctr1 As CommandBarButton
cancellaMenu
Set cbr = Application.CommandBars.Add(Name:="MyCustomToolbar", _
Position:=MsoBarPosition.msoBarPopup, _
MenuBar:=False, _
Temporary:=True)
caricaMenu cbr, ctr1, ActiveSheet, 15, 6 'carica il menu
Application.CommandBars("MyCustomToolbar").ShowPopup 'mostra il menu
End Sub
La routine cancellaMenu serve a cancellare il menu precedente all'atto della creazione di un nuovo menu, altrimenti risulta un errore:
Private Sub cancellaMenu()
On Error GoTo fine
Application.CommandBars("MyCustomToolbar").Delete
fine:
End Sub
La routine showMenu dichiara un oggetto di tipo CommandBar e uno di tipo CommandBarButton.Quindi crea immediatamente una comandBar con il codice relativo (che non ho approfondito più di tanto, ancora, ma lo prendo per buono).
E quindi chiama la routine caricaMenu fornendo come parametro cbr come CommandBar, ctr1 come CommandBarButton, ActiveSheet come foglio, 15 e 6 come righe iniziale cui troverà il menu de caricare.
Queste routines vanno riscritte.
Innanzitutto, mi sembra piuttosto ridicolo fornire come parametro una variabile oggetto dichiarata e non istanziata.
Vediamo...
Public Sub showMenu()
Dim cbr As CommandBar
cancellaMenu
Set cbr = Application.CommandBars.Add(Name:="MyCustomToolbar", _
Position:=MsoBarPosition.msoBarPopup, _
MenuBar:=False, _
Temporary:=True)
caricaMenu cbr, 15, 6 'carica il menu
Application.CommandBars("MyCustomToolbar").ShowPopup 'mostra il menu
End Sub
Sub caricaMenu(menu As CommandBar, rigaIniziale As Integer, col As Integer)
Dim button As CommandBarButton
Dim k As Integer
k = rigaIniziale
Do While Cells(k, col).FormulaR1C1 <> ""
Set button = menu.Controls.Add(Type:=msoControlButton)
button.Caption = Cells(k, col).FormulaR1C1
button.Tag = Cells(k, col + 1).FormulaR1C1
button.OnAction = "'scrivi """ & button.Caption & """, """ & button.Tag & """'"
k = k + 1
Loop
Set button = menu.Controls.Add(Type:=msoControlButton)
button.Caption = " "
button.Tag = ""
button.OnAction = "'scrivi """ & button.Caption & """, """ & button.Tag & """'"
End Sub
Ho eliminato due parametri della funzione caricaMenu: il bottone, che ho dichiarato nella seconda routine direttamente col nome di button, e il foglio, che è ovvio essere il foglio calendario.Funziona lo stesso, passando come parametri soltanto il menu su cui caricare i bottoni e le coordinate del range da cui attingere i nomi.
Ma alla luce delle mie nuove acquisizioni sulla denominazione dei ranges, posso anche sostituire le coordinate del range Lista Nomi Mese con il nome del range stesso...
Sub caricaMenu(menu As CommandBar, rigaIniziale As Integer, col As Integer)
Dim button As CommandBarButton
For k = 1 To Range("ListaNomiMese").Rows.Count
Set button = menu.Controls.Add(Type:=msoControlButton)
button.Caption = Range("ListaNomiMese").Cells(k, 1).FormulaR1C1
button.OnAction = "'scrivi """ & button.Caption & """, """ & button.Tag & """'"
Next k
End Sub
Sì, così funziona.
Da ultimo, la routine scrivi, che scrive il testo del bottone nella cella che è stata cliccata col destro:
Sub scrivi(testo As String, etichetta As String)
Bersaglio.FormulaR1C1 = testo
conta 2, 8
conta 4, 9
End Sub
e chiama per due volte con parametri diversi la routine conta che fa parte delle routines di calcolo, che analizzerò successivamente.Faccio una sintesi di tutto il modulo gestoreMenu, che, una volta stabilito che il foglio sia un foglio Calendario, si occupa di individuare in quale campo si debba mostrare un menu e ne gestisce il funzionamento:
Sub avvioMenu(bers As Range)
If campoConMenu(bers) = True Then
Set Bersaglio = bers
showMenu
End If
End Sub
Function campoConMenu(campo As Range) As Boolean
If Intersect(campo, Range("TurnoNotte")) Is Nothing = False Then campoConMenu = True
If Intersect(campo, Range("TurnoGiorno")) Is Nothing = False Then
If festivo(campo.Offset(0, -1).FormulaR1C1) Then campoConMenu = True
End If
End Function
Function festivo(valore As String) As Boolean
If Weekday(CDate(Val(valore) & " " & ActiveSheet.Name)) = 1 Then festivo = True
End Function
Public Sub showMenu()
Dim cbr As CommandBar
cancellaMenu
Set cbr = Application.CommandBars.Add(Name:="MyCustomToolbar", _
Position:=MsoBarPosition.msoBarPopup, _
MenuBar:=False, _
Temporary:=True)
caricaMenu cbr, 15, 6 'carica il menu
Application.CommandBars("MyCustomToolbar").ShowPopup 'mostra il menu
End Sub
Sub caricaMenu(menu As CommandBar, rigaIniziale As Integer, col As Integer)
Dim button As CommandBarButton
For k = 1 To Range("ListaNomiMese").Rows.Count
Set button = menu.Controls.Add(Type:=msoControlButton)
button.Caption = Range("ListaNomiMese").Cells(k, 1).FormulaR1C1
button.OnAction = "'scrivi """ & button.Caption & """, """ & button.Tag & """'"
Next k
End Sub
Private Sub cancellaMenu()
On Error GoTo fine
Application.CommandBars("MyCustomToolbar").Delete
fine:
End Sub
Sub scrivi(testo As String, etichetta As String)
Bersaglio.FormulaR1C1 = testo
conta 2, 8
conta 4, 9
End Sub
Okay!
...dimenticavo l'ultimo bottone muto del menu, per cancellare un nome da una cella.
Rimaneggiamo un po' la caricaMenu.
Sub caricaMenu(menu As CommandBar, rigaIniziale As Integer, col As Integer)
Dim button As CommandBarButton
For k = 1 To Range("ListaNomiMese").Rows.Count
Set button = menu.Controls.Add(Type:=msoControlButton)
button.Caption = Range("ListaNomiMese").Cells(k, 1).FormulaR1C1
button.OnAction = "'scrivi """ & button.Caption & """, """ & button.Tag & """'"
Next k
Set button = menu.Controls.Add(Type:=msoControlButton)
button.Caption = ""
button.OnAction = "'scrivi """ & button.Caption & """, """ & button.Tag & """'"
End Sub
Presto fatto!
Nessun commento:
Posta un commento