Non perdere la proposta di Marius, prima di questo messaggio.
Il mio commento e' che se poni due pezzi dello stesso problema in due discussioni diverse allora crei le condizioni per non far capire la domanda e non avere risposte immediatamente utilizzabili (faccio riferimento a quanto si discute qui:
viewtopic.php?f=26&t=110368)Sovrapponendo le tue due discussioni io deduco le seguenti esigenze:
-fare in modo che in una cella venga inserita una stringa che simuli un numero, controllando che usi solo caratteri numerici, che non ci sia il segno "meno", che siano max 25 crt, che ci siano 0-1-2 decimali
-inserire in questa stringa eventuali "punti" da usare come separatori delle migliaia
Non e' chiaro se vuoi essere "repressivo" (cioe' eventuali discrepanze portano al messaggio "Ahi ahi, hai sbagliato; ritenta") o "propositivo" (cioe' gestire eventuali discrepanze; es i decimali oltre 2 vengono tagliati, eventuali caratteri non numerici vengono ignorati).
Volendo essere propositivo, io suggerisco quest'altro approccio, che e' basato sull'uso di un TextBox:
-fai una prova su un nuovo foglio di lavoro, e inseriscici un TextBox prelevandolo dal gruppo Controlli Activex; dimensionalo che sia in grado di ospitare la stringa max che hai in mente. Chiamalo TextBox1
-sul modulo di codice di questo foglio di lavoro, che assumo sia pulito (nessuna macro), inserisci questo insieme di codici:
- Codice: Seleziona tutto
Dim StopEv As Boolean, oCont
Private Sub TextBox1_Change()
Dim vPos As Long, nwTxt As String, maxLen As Long
If StopEv Then Exit Sub
'
maxLen = 25 '<<< Max numero di digit
'
StopEv = True
nwTxt = NumOnlyTx(TextBox1.Text)
vPos = InStr(1, nwTxt, ",", vbTextCompare)
If vPos > 0 And (Len(nwTxt) - vPos) >= 3 Then
nwTxt = Left(nwTxt, vPos + 2)
End If
If (vPos - 1) > maxLen Or Len(nwTxt) - vPos > maxLen Then
TextBox1.BackColor = RGB(255, 100, 100)
Else
TextBox1.BackColor = RGB(255, 255, 255)
End If
TextBox1.Text = nwTxt
StopEv = False
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim cTxt As String, nTxt As String, I As Long, dPos As Long, DecCnt As Long
'
If KeyCode = 27 Or (KeyCode > 36 And KeyCode < 41) Then
On Error Resume Next
Range(TextBox1.LinkedCell) = "'" & oCont
TextBox1.Visible = False
If KeyCode = 38 Then voff = -1
If KeyCode = 40 Then voff = 1
If KeyCode = 37 Then hoff = -1
If KeyCode = 39 Then hoff = 1
Range(TextBox1.LinkedCell).Offset(voff, hoff).Activate
On Error GoTo 0
End If
If (KeyCode = 13 Or KeyCode = 9) And TextBox1.BackColor = RGB(255, 255, 255) Then
cTxt = TextBox1.Text
dPos = InStr(1, cTxt, ",", vbTextCompare)
If dPos = 0 Then
dPos = Len(cTxt)
Else
nTxt = "," & Right(cTxt, Len(cTxt) - dPos)
If nTxt = "," Then nTxt = ",00": corri = 2
End If
For I = Len(cTxt) - Len(nTxt) + corri To 1 Step -1
If DecCnt > 0 And DecCnt Mod 3 = 0 Then nTxt = "." & nTxt
nTxt = Mid(cTxt, I, 1) & nTxt
DecCnt = DecCnt + 1
Next I
On Error Resume Next
Range(TextBox1.LinkedCell) = "'" & nTxt
TextBox1.Visible = False
Range(TextBox1.LinkedCell).Offset(1, 0).Activate
On Error GoTo 0
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myArea As String
If Target.Count > 1 Then Exit Sub
myArea = "B2:B10" '<<< L'area di applicazione
If Not Application.Intersect(Target, Range(myArea)) Is Nothing Then
oCont = Target.Value
Me.TextBox1.Top = Target.Cells(1, 1).Top
Me.TextBox1.Left = Target.Cells(1, 2).Left
Me.TextBox1.LinkedCell = Target.Cells(1, 1).Address
Me.TextBox1.Visible = True
Me.TextBox1.Text = Target.Value
Me.TextBox1.Activate
Me.TextBox1.SelStart = 0
Me.TextBox1.SelLength = Len(Me.TextBox1.Text)
Else
Me.TextBox1.Visible = False
End If
End Sub
Function NumOnlyTx(txt As String) As Variant
If Len(txt) > 0 Then
With CreateObject("VBScript.RegExp")
.Pattern = "[^0123456789,]" '
.Global = True
NumOnlyTx = (.Replace(txt, ""))
End With
Else
NumOnlyTx = ""
End If
End Function
Ora val sul foglio di lavoro, esci dalla modalita' Progettazione e seleziona la cella B2
Il textbox verra' posizionato accanto a B2 e puoi scriverci; il textbox accettera' solo caratteri numerici e virgola; in caso di virgola il textbox limita a 2 decimali; in ogni caso la parte numerica prima dell'eventuale virgola non potra' contenere piu' di 25 caratteri. Se oltre 25 crt allora il textbox si colora di rosso.
Tramite il tasto Enter oppure Tab in avanti, e se il textbox non e' Rosso, il contenuto del textbox verra' inserito nella cella previo l'inserimento dei separatori delle migliaia, e la cella successiva verso il basso viene selezionata.
L'eventuale uso del tasto Esc, oppure delle frecce di spostamento, fa abortire l'inserimento tramite textbox con "probabile" ripristino del valore inziale; inoltre le frecce provocano il conseguente spostamento della selezione.
Noterai nel codice della Worksheet_SelectionChange una istruzione marcata <<<, che identifica quale area del foglio attivera' la gestione di questo textbox e della sua logica (ora e' impostata su B2:B10).
Nella TextBox1_Change invece e' possibile dichiarare il numero max di digit per la parte intera del textbox (ora impostata su 25)
Modifica queste istruzioni come serve a te.
Nella mia intenzione questa e' la risposta ad ambedue le richieste, che ho trattato integrandole e non separatamente.
Vedi se trovi qualche spunto interessante...
