Condividi:        

userform controlli e macro

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

userform controlli e macro

Postdi miko » 21/05/11 12:02

ciao a tutti;
ho nuovamente bisogno del vostro aiuto per risolvere alcuni problemi riguardo il progetto che vi illustro.
in un foglio excel ho inserito una form contenenti dei pulsanti, come vi mostro nella immagine;
Immagine
cliccando una volta su uno dei pulsanti da 1 a 20 questo cambia colore da verde a rosso;
cliccando nuovamente sullo stesso pulsante il colore ritorna quello di default, verde.
con il pulsante azzera si può attribuire il colore verde di default contemporaneamente a tutti quei pulsanti che hanno il colore rosso;
per questo ho realizzato questa semplice macro:
Codice: Seleziona tutto
Private Sub AZZERA_Click()
  NUMERO_1.BackColor = vbGreen
  NUMERO_2.BackColor = vbGreen
  NUMERO_3.BackColor = vbGreen
  --------------------------------------
  NUMERO_19.BackColor = vbGreen
  NUMERO_20.BackColor = vbGreen
  End Sub


nella quale si ripete 20 volte la stessa linea di codice;
è possibile ottenere lo stesso risultato con una macro più elegante e concisa?
secondo problema:
cliccando un pulsante sulla form,immagine precedente, ad esempio il numero 1, vorrei che la macro evidenziasse in qualche modo, colorando la cella o il font, il numero corrispondente nel range B3:K... dove si trovano i valori, come da immagine successiva
Immagine
la macro però deve evidenziare, nelle colonne B-k, i numeri scelti sul form solo se tutti questi numeri sono presenti su una stessa riga del range B3:K...;
così ad esempio la riga 3, numeri gialli non deve essere evidenziata, mancando il numero 9 scelto sul form;
così anche le altre righe gialle, mancando altri numeri;
mentre le celle da evidenziare sono quelle della riga 5 in cui sono presenti tutti i numeri scelti sul form.
i valori sono disposti nelle colonne da B a K a partire dalla cella B3;
mentre le righe aumentano ogni volta che si aggiorna il file.
questa ultima macro è molto complessa per le mie conoscenze del vba;
vi ringrazio anticipatamente per i vostri contributi.
saluti
p.s. uso excel 2003
windows 10 - office 2013
miko
Utente Senior
 
Post: 520
Iscritto il: 29/12/09 10:44

Sponsor
 

Re: userform controlli e macro

Postdi Flash30005 » 21/05/11 13:15

Sarebbe meglio che inviassi il file
comunque credo che per il primo problema
potresti usare un For...next tipo:
Codice: Seleziona tutto
For I = 1 to 20
NUMERO_" & I & ".BackColor = vbGreen
next I


(da provare)

per il resto è consigliabile lavorare sul file

ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: userform controlli e macro

Postdi miko » 21/05/11 17:46

salve,
ho provato il codice suggerito, ma ho sempre errore alla seconda linea anche se ho provato a modificarla.
allego il file integro nella sua struttura, ma con poche righe per alleggerirlo.
nel modulo e nella form troverete semplici macro ricavabili con la registrazione;
forse si può ridurre il numero delle 20 macro identiche, numerate da 1 a 20, che fanno cambiare colore ai pulsanti cliccando su di essi.
http://www.filedropper.com/cercavaloriconform
saluti grazie
windows 10 - office 2013
miko
Utente Senior
 
Post: 520
Iscritto il: 29/12/09 10:44

Re: userform controlli e macro

Postdi Flash30005 » 21/05/11 19:03

Ho scaricato il file
il consiglio precedente non potrà mai funzionare (avevo fretta di uscire e l'ho buttato lì)
Nel frattempo ho fatto altri tentativi ma penso di dedicare più tempo alla seconda parte del problema

A più tardi.

ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: userform controlli e macro

Postdi Flash30005 » 22/05/11 01:03

Le modifiche apportate sono molte, provo a elencarle
Dichiari Public un VettN(20) as integer
Devi aggiungere questo vettN per ogni numero (assume il valore del numero altrimenti sarà valore 0 )
Codice: Seleziona tutto
Private Sub NUMERO_1_Click()
If NUMERO_1.BackColor = vbGreen Then
NUMERO_1.BackColor = vbRed
VettN(1) = 1
Else
NUMERO_1.BackColor = vbGreen
VettN(1) = o
End If
End Sub

Private Sub NUMERO_10_Click()
If NUMERO_10.BackColor = vbGreen Then
NUMERO_10.BackColor = vbRed
VettN(10) = 10
Else
NUMERO_10.BackColor = vbGreen
VettN(10) = 0
End If
End Sub

Private Sub NUMERO_11_Click()
If NUMERO_11.BackColor = vbGreen Then
NUMERO_11.BackColor = vbRed
VettN(11) = 11
Else
NUMERO_11.BackColor = vbGreen
VettN(11) = 0
End If
End Sub

Private Sub NUMERO_12_Click()
If NUMERO_12.BackColor = vbGreen Then
NUMERO_12.BackColor = vbRed
VettN(12) = 12
Else
NUMERO_12.BackColor = vbGreen
VettN(12) = 0
End If
End Sub

Private Sub NUMERO_13_Click()
If NUMERO_13.BackColor = vbGreen Then
NUMERO_13.BackColor = vbRed
VettN(13) = 13
Else
NUMERO_13.BackColor = vbGreen
VettN(13) = 0
End If
End Sub

Private Sub NUMERO_14_Click()
If NUMERO_14.BackColor = vbGreen Then
NUMERO_14.BackColor = vbRed
VettN(14) = 14
Else
NUMERO_14.BackColor = vbGreen
VettN(14) = 0
End If
End Sub

Private Sub NUMERO_15_Click()
If NUMERO_15.BackColor = vbGreen Then
NUMERO_15.BackColor = vbRed
VettN(15) = 15
Else
NUMERO_15.BackColor = vbGreen
VettN(15) = 0
End If
End Sub

Private Sub NUMERO_16_Click()
If NUMERO_16.BackColor = vbGreen Then
NUMERO_16.BackColor = vbRed
VettN(16) = 16
Else
NUMERO_16.BackColor = vbGreen
VettN(16) = 0
End If
End Sub

Private Sub NUMERO_17_Click()
If NUMERO_17.BackColor = vbGreen Then
NUMERO_17.BackColor = vbRed
VettN(17) = 17
Else
NUMERO_17.BackColor = vbGreen
VettN(17) = 0
End If
End Sub

Private Sub NUMERO_18_Click()
If NUMERO_18.BackColor = vbGreen Then
NUMERO_18.BackColor = vbRed
VettN(18) = 18
Else
NUMERO_18.BackColor = vbGreen
VettN(18) = 0
End If
End Sub

Private Sub NUMERO_19_Click()
If NUMERO_19.BackColor = vbGreen Then
NUMERO_19.BackColor = vbRed
VettN(19) = 19
Else
NUMERO_19.BackColor = vbGreen
VettN(19) = 0
End If
End Sub

Private Sub NUMERO_2_Click()
If NUMERO_2.BackColor = vbGreen Then
NUMERO_2.BackColor = vbRed
VettN(2) = 2
Else
NUMERO_2.BackColor = vbGreen
VettN(2) = 0
End If
End Sub

Private Sub NUMERO_20_Click()
If NUMERO_20.BackColor = vbGreen Then
NUMERO_20.BackColor = vbRed
VettN(20) = 20
Else
NUMERO_20.BackColor = vbGreen
VettN(20) = 0
End If
End Sub

Private Sub NUMERO_3_Click()
If NUMERO_3.BackColor = vbGreen Then
NUMERO_3.BackColor = vbRed
VettN(3) = 3
Else
NUMERO_3.BackColor = vbGreen
VettN(3) = 0
End If
End Sub

Private Sub NUMERO_4_Click()
If NUMERO_4.BackColor = vbGreen Then
NUMERO_4.BackColor = vbRed
VettN(4) = 4
Else
NUMERO_4.BackColor = vbGreen
VettN(4) = 0
End If
End Sub

Private Sub NUMERO_5_Click()
If NUMERO_5.BackColor = vbGreen Then
NUMERO_5.BackColor = vbRed
VettN(5) = 5
Else
NUMERO_5.BackColor = vbGreen
VettN(5) = 0
End If
End Sub

Private Sub NUMERO_6_Click()
If NUMERO_6.BackColor = vbGreen Then
NUMERO_6.BackColor = vbRed
VettN(6) = 6
Else
NUMERO_6.BackColor = vbGreen
VettN(6) = 0
End If
End Sub

Private Sub NUMERO_7_Click()
If NUMERO_7.BackColor = vbGreen Then
NUMERO_7.BackColor = vbRed
VettN(7) = 7
Else
NUMERO_7.BackColor = vbGreen
VettN(7) = 0
End If
End Sub

Private Sub NUMERO_8_Click()
If NUMERO_8.BackColor = vbGreen Then
NUMERO_8.BackColor = vbRed
VettN(8) = 8
Else
NUMERO_8.BackColor = vbGreen
VettN(8) = 0
End If
End Sub

Private Sub NUMERO_9_Click()
If NUMERO_9.BackColor = vbGreen Then
NUMERO_9.BackColor = vbRed
VettN(9) = 9
Else
NUMERO_9.BackColor = vbGreen
VettN(9) = 0
End If
End Sub


Assegni un nuovo pulsante "Cerca"
Che richiamerà questo codice
Codice: Seleziona tutto
Private Sub CercaN_Click()
ContaN = 0
URB = Sheets("Foglio1").Range("B" & Rows.Count).End(xlUp).Row
Dim VettNC(10) As Integer

For I = 1 To 20
    If VettN(I) <> 0 Then
        ContaN = ContaN + 1
        VettNC(ContaN) = VettN(I)
    End If
Next I
    If ContaN < 2 Then
        MsgBox "Numeri insufficienti"
        Exit Sub
    End If
    If ContaN > 10 Then
        MsgBox "Selezionare max 10 numeri"
        Exit Sub
    End If


For RR = 3 To URB
Conta = 0
For CC = 2 To 11
    NumT = Cells(RR, CC).Value
    For NumC = 1 To ContaN
        If NumT = VettNC(NumC) Then
        Conta = Conta + 1
            Cells(RR, CC).Interior.ColorIndex = 3
            If Conta = ContN Then GoTo Salta
        End If
    Next NumC

Next CC
    If Conta < ContaN Then Range(Cells(RR, 2), Cells(RR, 11)).Interior.ColorIndex = 34
Salta:
Next RR

End Sub


Aggiungi alla macro azzera
questo codice
Codice: Seleziona tutto
Private Sub AZZERA_Click()
For I = 1 To 20
VettN(I) = 0
Next I
URB = Sheets("Foglio1").Range("B" & Rows.Count).End(xlUp).Row
Range("B3:K" & URB).Interior.ColorIndex = 34
NUMERO_1.BackColor = vbGreen '<<< esistente


E dovrebbe funzionare come richiesto
(per il primo problema non vale la pena perderci tempo, il codice è già scritto e funziona)

allego il file

Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: userform controlli e macro

Postdi miko » 22/05/11 10:41

ciao,
ho provato il file che hai realizzato, funziona benissimo ed è anche veloce. almeno con poche righe; proverò inserendo ulteriori righe.
ottima anche la scelta del pulsante cerca.
c'è solo un piccolo inconveniente, ma trascurabile, quando si cerca una quantità di numeri superiori a 10;
leggendo la macro associata al pulsante cerca dovrebbe comparire il messaggio
"Selezionare max 10 numeri", ma invece excel si blocca e la finestra che appare recita:
"errore n....
indice non incluso nell'intervallo"
ed il debug evidenzia la seguente linea di codice sempre del pulsante cerca:
Private Sub CercaN_Click()
......
URB = Sheets("Foglio1").Range("B" & Rows.Count).End(xlUp).Row
.........
For I = 1 To 20
......
ContaN = ContaN + 1
VettNC(ContaN) = VettN(I)
End If
...............
ma come scrivevo è un piccolo problema trascurabile e tutto il resto funziona molto bene.
grazie buona domenica
windows 10 - office 2013
miko
Utente Senior
 
Post: 520
Iscritto il: 29/12/09 10:44

Re: userform controlli e macro

Postdi Flash30005 » 22/05/11 11:28

Si è vero
dimensiona il vettore a 20 e non a 10 in questa maniera
Codice: Seleziona tutto
Dim VettNC(20) As Integer


oppure basterebbe spostare la condizione If all'interno del for...next conteggio

Codice: Seleziona tutto
   Dim VettNC(10) As Integer

For I = 1 To 20
    If VettN(I) <> 0 Then
        ContaN = ContaN + 1
            If ContaN > 10 Then
        MsgBox "Selezionare max 10 numeri"
        Exit Sub
    End If
        VettNC(ContaN) = VettN(I)
    End If
Next I
    If ContaN < 2 Then
        MsgBox "Numeri insufficienti"
        Exit Sub
    End If


Ambedue le soluzione vanno bene, scegli tu

ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: userform controlli e macro

Postdi miko » 23/05/11 12:25

salve,
ho effettuato le ultime modifche che hai suggerito, e naturalmente il problema dell'msgbox è stato risolto.
ho inserito tutte le righe a mia disposizione, quasi 10000, ed ho notato che il procedimento di ricerca e colorazione delle celle è molto rallentato;
è possibile velocizzare l'esecuzione, forse la colorazione del font invece che delle celle può essere più veloce?
oppure si può pensare ad un modo diverso per affrontare il problema?
grazie, saluti
windows 10 - office 2013
miko
Utente Senior
 
Post: 520
Iscritto il: 29/12/09 10:44

Re: userform controlli e macro

Postdi Flash30005 » 23/05/11 12:58

Non credo cambi molto colorare il font o il fondo
prova ad inserire all'inzio della macro queste due righe di codice

Codice: Seleziona tutto
Private Sub CercaN_Click() 'macro pulsante Cerca
Application.ScreenUpdating = False  '<<<< inserire qui
Application.Calculation = xlManual  '<<<< inserire qui
'... Macro esistente
'...

alla fine della macro questo codice per ripristinare il calcolo automatico e l'aggiornamento schermate
Codice: Seleziona tutto
'...
'... macro esistente
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: userform controlli e macro

Postdi miko » 24/05/11 11:42

ciao,
hai ragione, anche colorando il font non si nota alcun cambiamento nella velocità di esecuzione;
e pure l'inserimento delle ultime linee di codice, ad inizio e fine macro, non rendono più veloce l'elaborazione.
lasciamo tutto come hai realizzato, funziona tutto molto bene, possiamo aspettare qualche secondo in più per ottenere il risultato.
saluti e grazie
windows 10 - office 2013
miko
Utente Senior
 
Post: 520
Iscritto il: 29/12/09 10:44


Torna a Applicazioni Office Windows


Topic correlati a "userform controlli e macro":


Chi c’è in linea

Visitano il forum: Nessuno e 45 ospiti