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 SubLa 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 SubLa 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 SubHo 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 SubSì, 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 Sube 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 SubOkay!
...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