Codici VBA
Macro - Maiuscolo
Sub maiuscolo ()
Dim celle As Range
Set celle = Selection
For Each celle In celle
celle.value = UCase(celle)
Next celle
End Sub
Macro - Minuscolo
Sub minuscolo ()
Dim celle As Range
Set celle = Selection
For Each celle In celle
celle.value = LCase(celle)
Next celle
End Sub
Macro - Contenuto cella
Sub value ()
MsgBox “il valore inserito in Z40 è: “ & Range(“Z40”).value
End Sub
Macro - Istruzione If/Then
Sub IfThen ()
Dim valore As Integer, risultato As String
valore = Range("A1").value
If valore > 10 Then
risultato = "Cella A1 maggiore di 10"Else
risultato = "Cella A1 minore o uguale di 10"End IfRange("B1").value = risultato
End Sub
Funzione - Conta celle in base al colore
Function ContaCellePerColore(rData As Range, cellRefColor As Range) As Long
Dim indRefColor As Long
Dim cellaCorrente As Range
Dim cntRes As Long
Application.Volatile
cntRes = 0
indRefColor = cellRefColor.Cells(1, 1).Interior.Color
For Each cellaCorrente In rData
If indRefColor = cellaCorrente.Interior.Color Then
cntRes = cntRes + 1
End If
Next cellaCorrente
ContaCellePerColore = cntRes
End Function
Funzione - Conta celle in base al colore del carattere
Function ContaCellePerColoreCarattere(rData As Range, cellRefColor As Range) As Long
Dim indRefColor As Long
Dim cellaCorrente As Range
Dim cntRes As Long
Application.Volatile
cntRes = 0
indRefColor = cellRefColor.Cells(1, 1).Font.Color
For Each cellaCorrente In rData
If indRefColor = cellaCorrente.Font.Color Then
cntRes = cntRes + 1
End If
Next cellaCorrente
ContaCellePerColoreCarattere = cntRes
End Function
Funzione - Somma celle in base al colore del carattere
Function SommaCellePerColoreCarattere(rData As Range, cellRefColor As Range)
Dim indRefColor As Long
Dim cellaCorrente As Range
Dim sumRes
Application.Volatile
sumRes = 0
indRefColor = cellRefColor.Cells(1, 1).Font.Color
For Each cellaCorrente In rData
If indRefColor = cellaCorrente.Font.Color Then
sumRes = WorksheetFunction.Sum(cellaCorrente, sumRes)
End If
Next cellaCorrente
SommaCellePerColoreCarattere = sumRes
End Function
Funzione - Somma celle in base al colore
Function SommaCellePerColore(rData As Range, cellRefColor As Range)
Dim indRefColor As Long
Dim cellaCorrente As RangeDim sumRes
Application.Volatile
sumRes = 0
indRefColor = cellRefColor.Cells(1, 1).Interior.Color
For Each cellaCorrente In rData
If indRefColor = cellaCorrente.Interior.Color Then
sumRes = WorksheetFunction.Sum(cellaCorrente, sumRes)
End If
Next cellaCorrente
SommaCellePerColore = sumRes
End Function
Funzione - Moltiplica celle in base al colore
Function MoltiplicaCellePerColore(rData As Range, cellRefColor As Range) As Double
Dim indRefColor As Long
Dim cellaCorrente As Range
Dim prodRes As Double
Application.Volatile
prodRes = 1
indRefColor = cellRefColor.Cells(1, 1).Interior.Color
For Each cellaCorrente In rData
If indRefColor = cellaCorrente.Interior.Color Then
prodRes = cellaCorrente.Value * prodRes
End IfNext cellaCorrente
MoltiplicaCellePerColore = prodRes
End Function
Funzione - Moltiplica celle in base al colore carattere
Function MoltiplicaCellePerColoreCarattere(rData As Range, cellRefColor As Range) As Double
Dim indRefColor As Long
Dim cellaCorrente As Range
Dim prodRes As Double
Application.Volatile
prodRes = 1
indRefColor = cellRefColor.Cells(1, 1).Font.Color
For Each cellaCorrente In rData
If indRefColor = cellaCorrente.Font.Color Then
prodRes = cellaCorrente.Value * prodRes
End If
Next cellaCorrente
MoltiplicaCellePerColoreCarattere = prodRes
End Function
Macro - Motore di ricerca
Private Sub TextBox1_Change()
filtro = "*" & Sheets("Ricerca").TextBox1.Text & "*"Range("c7").AutoFilter field:=3, Criteria1:=filtro
End Sub
Pulsante Accedi
Private Sub btnLogin_Click()
Dim nomeUtente As String
Dim password As String
nomeUtente = txtNomeUtente.Text
password = txtPassword.Text
If VerificaCredenziali(nomeUtente, password) Then
ThisWorkbook.Sheets("Riservato").Visible = xlSheetVisible
Unload Me
Else
MsgBox "Nome utente o password errati. Riprova.", vbExclamation, "Accesso negato"
End If
End Sub
Function VerificaCredenziali(nomeUtente As String, password As String) As Boolean
Const nomeUtenteCorretto As String = "testExcel"
Const passwordCorretta As String = "testExcel"
If nomeUtente = nomeUtenteCorretto And password = passwordCorretta Then
VerificaCredenziali = True
Else
VerificaCredenziali = False
End If
End Function
Macro per visualizzare form
Sub login_Click()
login.Show
End Sub
Macro per logout
Sub btnLogout_Click()
ThisWorkbook.Sheets("Riservato").Visible = xlSheetVeryHidden
End Sub