Discussione: Corso VBA
Visualizza messaggio singolo
Vecchio 27-07-2014, 10.15.48   #51
Alexsandra
Senior Member
WT Expert
 
L'avatar di Alexsandra
 
Registrato: 19-05-2007
Loc.: Verona
Messaggi: 1.302
Alexsandra è conosciuto da tuttiAlexsandra è conosciuto da tuttiAlexsandra è conosciuto da tuttiAlexsandra è conosciuto da tuttiAlexsandra è conosciuto da tutti
#2

Convertire testo in maiuscolo e cambiare colore al carattere alle celle che contengono formule, formule e numeri e costanti


Convertire qualsiasi immissione in maiuscolo (testo o formula)
Codice:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
'Questo controllo impedisce di ripetere la procedura 
 If Not Target.Text = UCase(Target.Text) Then
If Target.HasFormula = True Then
Target.Formula = "=UPPER(" & Mid(Target.Formula, 2) & ")"
'Mid(Target.Formula, 2)  elimina “=” dalla formula
Else
Target = UCase(Target.Text)
End If
End If
End If
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Column = 1 Then
'Questo controllo impedisce di ripetere la procedura 
If .Value <> UCase(.Value) Then
If .HasFormula = True Then
.Formula = "=UPPER(" & Right(.Formula, Len(.Formula) - 1) & ")"
'in alternative si può usare: 
'.Formula = "=UPPER(" & Mid(.Formula, 2) & ")"
‘per eliminare “=” dalla formula
'Right(.Formula, Len(.Formula) - 1)
'Mid(Target.Formula, 2
Else
.Value = UCase(.Value)
End If
End If
End If
End With
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If Not Application.Intersect(Target, Range("A1:C10")) Is Nothing Then
'Questo controllo impedisce di ripetere la procedura 
If .Value <> UCase(.Value) Then
If .HasFormula = True Then
.Formula = "=UPPER(" & Right(.Formula, Len(.Formula) - 1) & ")"
'in alternative si può usare: 
.Formula = "=UPPER(" & Mid(.Formula, 2) & ")"
‘per eliminare “=” dalla formula
'Right(.Formula, Len(.Formula) - 1)
'Mid(Target.Formula, 2
Else
.Value = UCase(.Value)
End If
End If
End If
End With
End Sub

Sub Maiuscolo()
Dim Cell As Range
For Each Cell In Selection.Cells
If Not Cell.HasFormula Then
'In alternativa: "If Cell.HasFormula = False Then"
Cell = UCase(Cell)
End If
Next
End Sub

Cambiare colore al carattere nelle celle contenenti formule, formule e numeri e costanti

Codice:
Sub Colore1()
Dim Col_F As Long, Col_FN As Long, Col_C As Long, cell As Range

Col_F = RGB(Red:=0, Green:=255, Blue:=0)
Col_FN = RGB(Red:=0, Green:=0, Blue:=0)
Col_C = RGB(Red:=0, Green:=0, Blue:=255)
'imposta il colore alle celle che contengono formule
For Each cell In ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
cell.Font.Color = Col_F
Next cell
'imposta il colore alle celle che contengono formule e numeri
For Each cell In ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas, xlNumbers)
Next cell
'imposta il colore alle celle che contengono costanti (non formule)
For Each cell In ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)
cell.Font.Color = Col_C
Next cell
End Sub

Sub Colore2()
Dim Col_F As Long, Col_FN As Long, Col_C As Long, cell As Range

Col_F = RGB(Red:=0, Green:=255, Blue:=0)
Col_FN = RGB(Red:=0, Green:=0, Blue:=0)
Col_C = RGB(Red:=0, Green:=0, Blue:=255)

For Each cell In ActiveSheet.UsedRange
'imposta il colore alle celle che contengono formule
If cell.HasFormula = True Then
cell.Font.Color = Col_F
'imposta il colore alle celle che contengono formule e numeri
If IsNumeric(cell) = True Then
cell.Font.Color = Col_FN
End If
Else
'imposta il colore alle celle che contengono costanti (non formule)
cell.Font.Color = Col_C
End If
Next cell
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Col_F As Long, Col_FN As Long, Col_C As Long

Col_F = RGB(Red:=0, Green:=255, Blue:=0)
Col_FN = RGB(Red:=0, Green:=0, Blue:=0)
Col_C = RGB(Red:=0, Green:=0, Blue:=255)

With Target
'imposta il colore alle celle che contengono formule
If .HasFormula Then
.Font.Color = Col_F
'imposta il colore alle celle che contengono formule e numeri
If IsNumeric(Target) Then
.Font.Color = Col_FN
End If
'imposta il colore alle celle che contengono costanti (non formule)
Else
.Font.Color = Col_C
End If
End With
End Sub
___________________________________

- Il primo fondamento della sicurezza non e' la tecnologia, ma l'attitudine mentale -
Alexsandra non è collegato   Rispondi citando