Post by PippoSu consiglio di Ivano (che ringrazio per la sua tempestiva
riposta) a cui chiedo scusa per il mio precedente post
avente per oggetto:"Ridefinire velocemente il nome di un
Nella cella "B1" ho un elenco a discesa che punta
all'intervallo "A1:A10".Inserendo un nuovo dato in "A11",
l'elenco a discesa si deve aggiornare automaticamente e
puntare al nuovo intervallo "A1:A11".
Ogni volta che inserisco un nuovo dato nella colonna "A",
l'elenco a discesa in "B1" si deve aggiornare puntando al
nuovo intervallo, e possibilmente, presentare i dati
*ordinati alfabeticamente*.
Ciao, Pippo.
Quello che segue e' un abbozzo della stessa cosa realizzata in Visual
Basic. Da rivedere, verificare e integrare con qualche controllo in piu'...
tipo il controllo nel caso si elimini l'ultimo elemento della lista.
La procedura presuppone esista un intervallo denominato "Valori", con
etichetta di intestazione, per esempio:
| H |
---+-------------+
1 | Valori |
2 | Clarabella |
3 | Orazio |
4 | Topolino |
dove l'intervallo di nome "Valori" e':
H2:H4
e una o piu' celle con elenco di convalida la cui origine sia:
=Valori
Copiare il codice nel modulo di classe dell'oggetto Foglio di lavoro in
cui sono presenti sia l'elenco "Valori" che la o le celle con elenco di
convalida.
Testare cancellando elementi dall'elenco (escluso l'ultimo che rimane) o
aggiungendo elementi immediatamente sotto l'elenco, per esempio nel caso qui
sopra il primo nuovo elemento andra' aggiunto in H5.
La procedura dovrebbe, nel caso di cancellazione, ridefinire
l'intervallo di nome "Valori"; nel caso di aggiunta, riordinare
alfabeticamente e ridefinire.
' ============================================================
'
' Maurizio Borrelli
'
' ------------------------------------------------------------
Option Base 0
Option Compare Text
Option Explicit
' ------------------------------------------------------------
Const mc_strMyName = "Foglio1"
' ------------------------------------------------------------
Const mc_strValori = "Valori"
' ============================================================
Private Function GetValidationFormula1( _
ByVal rng As Excel.Range _
) As String
' ------------------------------------------------------------
Const c_strMyName = "GetValidationFormula1"
' ------------------------------------------------------------
On Error Resume Next
GetValidationFormula1 = rng.Validation.Formula1
End Function
' ============================================================
' ============================================================
Private Sub Worksheet_Change( _
ByVal Target As Excel.Range)
' ------------------------------------------------------------
Const c_strMyName = "Worksheet_Change"
On Error GoTo ErrorHandler
' ------------------------------------------------------------
Dim objXlTarget As Excel.Range
Dim objXlRngValori As Excel.Range
Dim objXlRngValore As Excel.Range
Dim objXlRng As Excel.Range
' ------------------------------------------------------------
Dim blnValori As Boolean
' ------------------------------------------------------------
'Exit Sub
Set objXlTarget = Target.Resize(1, 1)
Set objXlRngValori = Me.Range(mc_strValori)
If (Intersect(objXlTarget, objXlRngValori) Is Nothing) Then
With objXlRngValori
Set objXlRngValore = .Resize(1, 1).Offset(.Rows.Count)
End With
If (Intersect(objXlTarget, objXlRngValore) Is Nothing) Then
' DO NOTHING
Else
With objXlRngValori
Set objXlRngValori = .Resize(.Rows.Count + 1)
End With
objXlRngValori.Sort key1:=objXlRngValori, header:=xlNo
Me.Names.Add mc_strValori, objXlRngValori
blnValori = True
End If
Else
objXlRngValori.Sort key1:=objXlRngValori, header:=xlNo
With objXlRngValori
Set objXlRngValore = .Resize(1, 1).Offset(.Rows.Count - 1)
End With
If Len(objXlRngValore) Then
' DO NOTHING
Else
With objXlRngValori
Set objXlRngValori = .Resize(.Rows.Count - 1)
End With
Me.Names.Add mc_strValori, objXlRngValori
End If
blnValori = True
End If
If (blnValori) Then
For Each objXlRng In Me.UsedRange
If (GetValidationFormula1(objXlRng) = "=" & mc_strValori) Then
objXlRng.ClearContents
End If
Next
End If
ExitProcedure:
Set objXlRng = Nothing
Set objXlRngValore = Nothing
Set objXlRngValori = Nothing
Set objXlTarget = Nothing
Exit Sub
ErrorHandler:
With Err
MsgBox "Source: " & .Source _
& vbNewLine & "ERR#" & CStr(.Number) _
& vbNewLine & .Description _
, vbCritical Or vbOKOnly _
, mc_strMyName & "." & c_strMyName
End With
Resume ExitProcedure
End Sub
' ============================================================
--
(Facci sapere se ed eventualmente come hai risolto. Grazie.)
Ciao :o)
Maurizio Borrelli, Microsoft MVP - Office Systems - Access
--------
?SPQR(C)
X
--------