Condividi:        

Modifica Macro Inserimento Numeri

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Modifica Macro Inserimento Numeri

Postdi Francesco6918 » 13/05/14 00:32

Un saluti a tutti gli amici del forum cerco un aiuto nel modificare una macro creatami in passato da Anthony47 in questo forum.
La macro a la funzione di selezionare un range N3:W3 e mi inserisce dei numeri min 0 max 90 e funziona perfettamente, vorrei modificare esclusivamante il punteggio con numeri decimali min 0.00 max 20.5 con un incremento di 0.01. non sono capace nel modificare tale macro o ricrearne un altra, vi invio il codice macro più il file come esempio.
MACRO DI Anthony47
Codice: Seleziona tutto
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
SpinnArea = ("P6:U6")
If Application.Intersect(Target, Range(SpinnArea)) Is Nothing Then Exit Sub
   
Application.EnableEvents = False
    ActiveSheet.Shapes.Range(Array("Spinner 1")).Select
    With Selection
        ctarget = Target.Value
        .Min = 0
        .Max = 90
        .SmallChange = 1
        .LinkedCell = Target.Address
        .Value = ctarget
        .Display3DShading = True
    End With
Target.Select
Application.EnableEvents = True
End Sub


File Esempio

http://www.filedropper.com/inserimentonumeri
Francesco6918
Utente Senior
 
Post: 265
Iscritto il: 04/03/11 11:20

Sponsor
 

Re: Modifica Macro Inserimento Numeri

Postdi Anthony47 » 13/05/14 14:28

La discussione originale e' questaa: viewtopic.php?p=577873
E la macro consente di impostare i valori delle celle nell' area definita tramite uno spinbutton, che la macro associa volta per volta a una cella diversa.

Per la nuova richiesta, devi considerare che lo spinner ha la capacita di incrementare a blocco minimo di 1 unita'; se vuoi simulare un incremento inferiore devi creare un artifizio.
Ad esempio puoi impostare
Codice: Seleziona tutto
.Max = 20500
.SmallChange = 10

e poi userai una formattazione speciale per "visualizzare" quello che serve:
-selezioni l' area su cui lavora lo spinner
-avvia la formattazione celle, tab Numero, Categoria=personalizzato
-come "Tipo" imposti "#.##0,00." (senza le virgolette).
In questo modo quando la cella conterra' mettiamo 1230 sara' visualizzato invece 1,23; questo, insieme alle impostazione dello spinbutton dovrebbero avvicinarsi alla tua richiesta. RICORDA pero' che se usi in calcoli successivi i valori impostati in questo modo essi sono pari al visualizzato moltiplicato per 1000.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Modifica Macro Inserimento Numeri

Postdi Francesco6918 » 13/05/14 16:40

Ciao Anthony47 grazie tutto ok

Saluti
Francesco6918
Utente Senior
 
Post: 265
Iscritto il: 04/03/11 11:20

Re: Modifica Macro Inserimento Numeri

Postdi Francesco6918 » 13/05/14 18:29

Ciao Anthony47 se voglio aggiungere un altro pulsante di selezione per il range P8:U8 come dovrei comportarmi? dovrei fare un altra macro sostituendo il range , spiegami o fammi un esempio.
Francesco6918
Utente Senior
 
Post: 265
Iscritto il: 04/03/11 11:20

Re: Modifica Macro Inserimento Numeri

Postdi Anthony47 » 13/05/14 22:42

Devi concatenare due verifiche e la gestione delle proprieta' di due spinner. Ad esempio:
Codice: Seleziona tutto
SpinnArea = ("P6:U6")                 '<<< Prima area, gestita da primo spinner
If Application.Intersect(Target, Range(SpinnArea)) Is Nothing Then Goto test2
'qui Application.EnableEvents = False
    ActiveSheet.Shapes.Range(Array("Spinner 1")).Select
    With Selection
        ctarget = Target.Value
        .Min = 0
        .Max = 90
        .SmallChange = 1
        .LinkedCell = Target.Address
        .Value = ctarget
        .Display3DShading = True
    End With
Target.Select
Application.EnableEvents = True
Exit Sub
'
Test2:
'Gestione secondo spinner
SpinnArea = ("AA6:AU6")            '<<< Seconda area, gestita da secondo spinner
If Application.Intersect(Target, Range(SpinnArea)) Is Nothing Then Goto Exit1
'qui codice di gestione spinner2:
'qui Application.EnableEvents = False
    ActiveSheet.Shapes.Range(Array("Spinner 2")).Select
    With Selection
        ctarget = Target.Value
        .Min = 0
        .Max = 90
        .SmallChange = 1
        .LinkedCell = Target.Address
        .Value = ctarget
        .Display3DShading = True
    End With
Target.Select
Exit1:
Application.EnableEvents = True
Exit Sub

Ovviamente e' un esempio, da personalizzare sui tuoi dati.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Modifica Macro Inserimento Numeri

Postdi Francesco6918 » 14/05/14 11:32

Ciao Anthony grazie ci sono riuscito.
Saluti
Francesco6918
Utente Senior
 
Post: 265
Iscritto il: 04/03/11 11:20

Re: Modifica Macro Inserimento Numeri

Postdi Francesco6918 » 14/05/14 14:45

Ciao Anthony scusa se sono ripetitivo ma o provato a inserire un 3 pulsante per il range L9:T9 ma no riesco a attivarlo,fino 2 ci sono riuscito in poche parole dovrei inserire 20 pulsanti per i 20 range , ti invio il file dove o inserito il 3 pulsante controlla la macro per verificare l errore in modo da capire per i prossimi pulsanti.

Saluti

http://www.filedropper.com/prova_4
Francesco6918
Utente Senior
 
Post: 265
Iscritto il: 04/03/11 11:20

Re: Modifica Macro Inserimento Numeri

Postdi Anthony47 » 14/05/14 23:22

Allora la gestione del secondo spinner non deve finire in Exit1 ma in Test3, dove inserirai la gestione del tesrzo spinner esattamente come gestivamo prima il secondo.
Quindi qualcosa come
Codice: Seleziona tutto
SpinnArea = ("AA6:AU6")            '<<< Seconda area, gestita da secondo spinner
If Application.Intersect(Target, Range(SpinnArea)) Is Nothing Then Goto Test3
'
'
'gestione secondo spinner
'
'Exit1:        '<<< DA ELIMINARE
Application.EnableEvents = True
Exit Sub
'
Test3:
'gestione terzo spinner:
SpinnArea = ("AZ1:AZ100")            '<<< Terza area, gestita da terzo spinner
If Application.Intersect(Target, Range(SpinnArea)) Is Nothing Then Goto Exit1
'
'
'gestione terzo spinner
'
Exit1:       
Application.EnableEvents = True
Exit Sub


Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Modifica Macro Inserimento Numeri

Postdi Francesco6918 » 15/05/14 00:16

Ciao Anthony io lo risolto modificandolo in questa maniera e riuscendo a applicarlo per i 20 pulsanti e funziona comunque con la tua macro, questo codice e per 4 pulsanti e continuando a 20, riprovero il tuo nuovo codice.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'

SpinnArea = ("L3:T3") '<<< Prima area, gestita da primo spinner
If Application.Intersect(Target, Range(SpinnArea)) Is Nothing Then GoTo Test2
'qui Application.EnableEvents = False
ActiveSheet.Shapes.Range(Array("Spinner 1")).Select
With Selection
ctarget = Target.Value
.Min = 0
.Max = 20500
.SmallChange = 10
.LinkedCell = Target.Address
.Value = ctarget
.Display3DShading = True
End With
Target.Select
Application.EnableEvents = True
Exit Sub
'
Test2:
'Gestione secondo spinner
SpinnArea = ("L6:T6") '<<< Seconda area, gestita da secondo spinner
If Application.Intersect(Target, Range(SpinnArea)) Is Nothing Then GoTo Test3
'qui codice di gestione spinner2:
'qui Application.EnableEvents = False
ActiveSheet.Shapes.Range(Array("Spinner 2")).Select
With Selection
ctarget = Target.Value
.Min = 0
.Max = 20500
.SmallChange = 10
.LinkedCell = Target.Address
.Value = ctarget
.Display3DShading = True
End With
Target.Select
Exit1:
Application.EnableEvents = True
Exit Sub
'
Test3:
'Gestione secondo spinner
SpinnArea = ("L9:T9") '<<< Seconda area, gestita da secondo spinner
If Application.Intersect(Target, Range(SpinnArea)) Is Nothing Then GoTo Test4
'qui codice di gestione spinner2:
'qui Application.EnableEvents = False
ActiveSheet.Shapes.Range(Array("Spinner 3")).Select
With Selection
ctarget = Target.Value
.Min = 0
.Max = 20500
.SmallChange = 10
.LinkedCell = Target.Address
.Value = ctarget
.Display3DShading = True
End With
Target.Select
Exit2:
Application.EnableEvents = True
Exit Sub
'
Test4:
'Gestione secondo spinner
SpinnArea = ("L12:T12") '<<< Seconda area, gestita da secondo spinner
If Application.Intersect(Target, Range(SpinnArea)) Is Nothing Then GoTo Exit3
'qui codice di gestione spinner3:
'qui Application.EnableEvents = False
ActiveSheet.Shapes.Range(Array("Spinner 4")).Select
With Selection
ctarget = Target.Value
.Min = 0
.Max = 20500
.SmallChange = 10
.LinkedCell = Target.Address
.Value = ctarget
.Display3DShading = True
End With
Target.Select
Exit3:
Application.EnableEvents = True
Exit Sub
End Sub


Grazie
Saluti
Francesco6918
Utente Senior
 
Post: 265
Iscritto il: 04/03/11 11:20

Re: Modifica Macro Inserimento Numeri

Postdi Francesco6918 » 15/05/14 01:24

Ciao Anthony47 riguardo la macro dei numeri decimali ai ragione i successivi li calcola 1000 e un problema per le mie formula invece i decimali da applicare 0,00 0,01 0,02 0,03 0,04 0,05 0,06 0,07 0,08 0,09 0,10 0,11 ecc fino 20,50 come lo risolvo il problema? aiutami.

Saluti
Francesco6918
Utente Senior
 
Post: 265
Iscritto il: 04/03/11 11:20

Re: Modifica Macro Inserimento Numeri

Postdi Anthony47 » 15/05/14 12:15

Se riusi in una formula la cella che visualizza (con quella formattazione) mettiamo 10,5 ma che contiene 10500, e vuoi che sia valorizzata giustamente 10,5 allora dovrai usare Cella/1000. Oppure, da usare in caso di numerose celle "dipendenti", calcoli in colonne di servizio che poi nascondi i valori divisi per 1000 e usi quelle celle nelle formule successive.

invece i decimali da applicare 0,00 0,01 0,02 0,03 0,04 0,05 0,06 0,07 0,08 0,09 0,10 0,11 ecc fino 20,50 come lo risolvo il problema?
Ma questo non era il problema risolto usando .Max = 20500 / .SmallChange = 10 e poi la formattazione speciale?

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Modifica Macro Inserimento Numeri

Postdi Francesco6918 » 15/05/14 19:07

Ciao Anthony dunque la macro riguardo l inserimento numeri lo impostata bene, mentre riguardo i numeri decimali o lasciato la tua formattazione #.##0,00. o modificato la mia formula dividendo per 1000 e funziona in base a quello che desideravo, ti ringrazio di tutto per la tua disponibilita ci sentiamo in seguito.

Saluti
Francesco6918
Utente Senior
 
Post: 265
Iscritto il: 04/03/11 11:20


Torna a Applicazioni Office Windows


Topic correlati a "Modifica Macro Inserimento Numeri":


Chi c’è in linea

Visitano il forum: Nessuno e 47 ospiti