+ Rispondi al Thread
Pagina 2 di 2 primaprima 12
Visualizzazione dei risultati da 11 a 18 su 18

Discussione: Problema con menu a tendina e macro

  1. #11
    Bensisko non è in linea Novello
    Post
    9
    Salve a tutti,
    intanto grazie per l' interessamento, rispondo a @Sgruabak non sono capace di creare un codice da zero il mio uso e utilizzo di vba e' molto limitato mi limito a cercare un codice in rete e poi tentare di adattarlo alle mie esigenze. Ho controllato bene ed effettivamente non mi ero accorto di aver sovrapposto alcune celle.
    Ho quindi riscritto il codice, modificando la stringa che seleziona le celle cosi..
    Codice:
    codice:
    Private Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Target, Range("$H$6:$T$6:$H$40:T$40:$H$73:$T$73:$H$107:$T$107")) Is Nothing Then
            Select Case Target.Value
            Case Is = "Riposo"
                Call Giorno_Riposo
            Case Is = "Congedo"
                Call Giorno_Riposo
            Case Is = "Ferie"
                Call Giorno_Riposo
            Case Is = "Festività"
                Call Giorno_Riposo
            Case Is = "Cancella Colonna"
                Call Giorno_Riposo_Cancella
            Case Isempy
            End Select
        End If
    
    End Sub
    Fermo restando che utilizzerò' le modifiche di forma proposte da Marius44 adesso in linea di massima funziona, ma ci sono margini di miglioramento.
    Ultima modifica di Bensisko; 14-09-2019 22:40 

  2. #12
    Bensisko non è in linea Novello
    Post
    9
    Grazie Marius44,
    ottimizzo con la tua versione del codice.

  3. #13
    Sgrubak non è in linea Scolaretto
    Luogo
    Torrazza Piemonte
    Post
    388
    Quel che hai scritto, equivale a scrivere:
    codice:
    Private Sub Worksheet_Change(ByVal Target As Range)
    if Not Intersect (Target,range("H6:T107")) Is Nothing Then
        Select Case Target.Value
            Case Is = "Riposo", "Congedo", "Ferie"
                Call Giorno_Riposo
            Case Else
                Call Giorno_Riposo_Cancella
         End Select
    End If
    End Sub
    Se devi controllare Range staccati l'uno dall'altro dovresti riscrivere la condizione dell'If come segue:
    codice:
    If Not (Intersect (Target,range("H6:T6")) Is Nothing And Intersect (Target,range("H40:T40")) Is Nothing And ...) Then
    Resta da chiarire che cosa fanno le due funzioni [Giorno_Riposo] e [Giorno_Riposo_Cancella].

  4. #14
    Bensisko non è in linea Novello
    Post
    9
    Quote Originariamente inviato da Sgrubak Visualizza il messaggio
    Quel che hai scritto, equivale a scrivere:
    codice:
    Private Sub Worksheet_Change(ByVal Target As Range)
    if Not Intersect (Target,range("H6:T107")) Is Nothing Then
        Select Case Target.Value
            Case Is = "Riposo", "Congedo", "Ferie"
                Call Giorno_Riposo
            Case Else
                Call Giorno_Riposo_Cancella
         End Select
    End If
    End Sub
    Se devi controllare Range staccati l'uno dall'altro dovresti riscrivere la condizione dell'If come segue:
    codice:
    If Not (Intersect (Target,range("H6:T6")) Is Nothing And Intersect (Target,range("H40:T40")) Is Nothing And ...) Then
    Resta da chiarire che cosa fanno le due funzioni [Giorno_Riposo] e [Giorno_Riposo_Cancella].
    Ciao, le 2 funzioni sopra elencate creano una serie di X (Giorno Riposo) e [Giorno_Riposo_Cancella] ripristina la colonna cancellando il tutto.
    Ora provo a modificare il codice secondo quanto avete scritto..

  5. #15
    Sgrubak non è in linea Scolaretto
    Luogo
    Torrazza Piemonte
    Post
    388
    Quote Originariamente inviato da Bensisko Visualizza il messaggio
    ...le 2 funzioni sopra elencate creano una serie di X (Giorno Riposo) e [Giorno_Riposo_Cancella] ripristina la colonna cancellando il tutto...
    Quello era pacifico. Dipende come glielo fai fare... Era per quello che ti suggerivo di postare il codice, così da darti i suggerimenti migliori.

  6. #16
    Bensisko non è in linea Novello
    Post
    9
    Ok, ecco il codice completo,
    lo scopo e' quello di modificare le colonne sottostanti a seconda di quello che viene selezionato nel menu a tendina sopra la data del giorno, di lato ci sono dei nominativi che vengono al loro volta selezionati in base ad un menu a tendina dinamico della colonna AUTISTA, a questo punto di fianco sulle giornate, scrivo il turno che si sviluppa in 5 giorni di solito se non ha turno metto la X, di fianco al turno nella colonna NOTE altro menu a tendina che indica delle note sul contattato o no, in cima nel menu dinamico a tendina sopra la data se io seleziono alcune voci alcune non deve succedere niente con altre voci la colonna di sotto deve essere o cancellata, o indicare delle "X"
    che stanno ad indicare NON UTILIZZARE. Ok spero di essermi spiegato meglio ecco il codice che finale modificato secondo i vs consigli.
    Codice:
    codice:
    Private Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Target, Range("$H$6:$T$6:$H$40:T$40:$H$73:$T$73:$H$107:$T$107")) Is Nothing Then
       ' If Not (Intersect(Target, Range("H6:T6")) Is Nothing And Intersect(Target, Range("H40:T40")) Is Nothing And Intersect(Target, Range("H73:T73")) Is Nothing And Intersect(Target, Range("H107:T107"))) Then
            Select Case Target.Value
            Case Is = "Riposo", "Congedo", "Ferie", "Festività", "Ho Mattinale"
                Call Giorno_Riposo
            Case Is = "A Casa x Mutua"
                Call Giorno_Mutua
            Case Is = "Cancella Colonna"
                Call Giorno_Riposo_Cancella
            Case Isempy
                End Select
         End If
    End Sub
    La seconda riga e' stata consigliata da te credo ma mi da un errore su with credo e si blocca allora ho ripreso la mia con le dovute modifiche sulla prima versione per evitare sovrapposizioni di celle.
    I sotto-menu o sottoprogrammi che richiamano hanno il solo scopo di cancellare o riempire le celle sottostanti la data se non ci sono turni da inserire
    Il primo inserisce le "x" L'altro la parola "Mutua" il terzo cancella la colonna, dato che non so che codice utilizzare per fargli cancellare la colonna automaticamente se lascio bianco il menu a tendina superiore alla data.

    codice:
    Sub Giorno_Riposo()
    
            ActiveCell.Offset(2, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "X"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "X"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "X"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "X"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "X"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "X"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "X"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "X"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "X"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "X"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "X"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "X"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "X"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "X"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "X"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "X"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "X"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "X"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "X"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "X"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "X"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "X"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "X"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "X"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "X"
            ActiveCell.Offset(-26, 0).Range("A1:B1").Select
        
    End Sub
    Sub Giorno_Riposo_Cancella()
    '
            ActiveCell.Offset(2, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = " "
            ActiveCell.Offset(-26, 0).Range("A1:B1").Select
        
    
    End Sub
    
    Sub Giorno_Mutua()
    '
            ActiveCell.Offset(2, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(1, 0).Range("A1:B1").Select
            ActiveCell.FormulaR1C1 = "Mutua"
            ActiveCell.Offset(-26, 0).Range("A1:B1").Select
        
    
    End Sub
    Con questo il tutto dovrebbe andare abbastanza bene, ma se provo dei copia e incolla tra i dati nella colonna sotto le date il codice mi da errore se invece lo scrivo a mano non succede e questo non capisco perche'.
    Come detto non uso spesso VBA pur avendolo un po' studiato non utilizzandolo con continuità' non son o mai riuscito a progredire quindi cerco di modificare i codici gia fatti e trovati in rete.
    Ultima modifica di Bensisko; 16-09-2019 11:18 

  7. #17
    Sgrubak non è in linea Scolaretto
    Luogo
    Torrazza Piemonte
    Post
    388
    Quote Originariamente inviato da Bensisko Visualizza il messaggio
    ...
    codice:
    If Not (Intersect(Target, Range("H6:T6")) Is Nothing  _ 
        And Intersect(Target, Range("H40:T40")) Is Nothing _ 
        And Intersect(Target, Range("H73:T73")) Is Nothing  _
        And Intersect(Target, Range("H107:T107")) Is Nothing) Then
    ...
    Manca l'ultimo pezzo che ho colorato in rosso.

    Come facciano a funzionare quelle Sub, è un miracolo! Questo copiaincollare senza comprendere ho paura ti si stia ritorcendo contro. In primis è inutile la continua selezione della cella con il metodo Select. In oltre quel [.Range("A1:B1")] lo trovo privo di senso.

    Ti suggerirei piuttosto di impostare un ciclo For come da spunto che ti lascio:
    codice:
    For i = 1 to 26
        Activecell.Offset(i,0).Value = "X"
    Next i
    Nota che ho sfruttato la proprietà [Value] e non la [FormulaR1C1] che serve appunto per inserire una formula.

    Dai anche uno sguardo veloce a cosa fanno le proprietà Application.EnableEvents e Application.ScreenUpdataing. Io le inserirei all'inizio della gestione dell'evento Change.

  8. #18
    Bensisko non è in linea Novello
    Post
    9
    Vero, ma i Due moduli sono stati creati col registratore di macro che ovviamente non crea il ciclo next e for comunque
    essendo concentrato sulla prima parte del codice non lo avevo preso ancora in considerazione, ora con la tua ultima correzione anche la parte
    If Not (Intersect......etc Funziona senza errori, ho anche inserito le istruzioni che mi hai indicato sotto alla fine

+ Rispondi al Thread
Pagina 2 di 2 primaprima 12

Permessi di invio

  • Non puoi inserire discussioni
  • Non puoi inserire repliche
  • Non puoi inserire allegati
  • Non puoi modificare i tuoi messaggi