martedì 23 settembre 2014

Gestione dei menu della mia applicazione Excel

Adesso vengo alla parte del codice che mostra i menu: la routine showMenu.

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