Embedded Files
Post date: Sep 16, 2012 4:26:32 PM
1) Maximize or minimize the Ribbon
If Application.CommandBars.Item("Ribbon").Visible = True Then 'Height > 80 Then
[a1].Select
SendKeys "^{F1}", True
End If
2) codice per verificare, avvisare, o eliminare voci doppie (in presenza di tante voci impiega molto tempo!)
Sub Doppione()
UltimaRiga = Range("A1").End(xlDown).Row
For I = 2 To UltimaRiga - 1
NomeOrigine = Cells(I, 1).Value
For K = UltimaRiga To I + 1 Step -1
MioNome = Cells(K, 1).Value
If NomeOrigine = MioNome Then
Cells(K, 1).Select
'MsgBox "Doppione" 'oppure se vuoi eliminare il doppione :
ActiveCell.EntireRow.Delete
End If
Next K
Next I
End Sub
‘Doppione potrebbe essere chiamata dal clic di un bottone messo nel foglio
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim Selezione As Range
Set Selezione = ActiveCell
Doppione
Selezione.Select
End Sub
3) codice per far lampeggiare celle del foglio in risposta a condizioni-eventi
Sub Lampeggia()
If Range("A1").Value = Date Then ' dove Date è la data attuale
Dim PauseTime, Start, Finish
For x = 1 To 5 'inizia il ciclo e lo ripete per 5 volte
PauseTime = 0.5 ' Imposta la durata in secondi. ho messo 1/2 secondo
Start = Timer ' Imposta l'ora di inizio.
Do While Timer < Start + PauseTime
DoEvents ' Passa il controllo ad altri processi.
Range("A2:D7").Cells.Interior.ColorIndex = 3 'colora il range di celle di rosso
Range("A8:D21").Cells.Interior.ColorIndex = 6 'colora il range di celle di giallo
Loop
Finish = Timer ' Imposta l'ora di fine della pausa.
PauseTime = 0.5 ' Imposta la durata.
Start = Timer ' Imposta l'ora di inizio.
Do While Timer < Start + PauseTime
DoEvents ' Passa il controllo ad altri processi.
Range("A2:D7").Cells.Interior.ColorIndex = 6
Range("A8:D21").Cells.Interior.ColorIndex = 3
Loop
Finish = Timer ' Imposta l'ora di fine della pausa.
Next x
Range("A2:D7").Cells.Interior.ColorIndex = xlNone 'cancella la colorazione
Range("A8:D21").Cells.Interior.ColorIndex = xlNone
End If
End Sub
4) codice per scrivere l’ora attuale e far apparire un messaggio (o scatenare un evento)
Sub OrarioConMessaggio()
Dim lngHour As Integer
Dim lngMinute As Integer
lngHour = Hour(Now())
lngMinute = Minute(Now())
[a2] = "sono le " & lngHour & " e " & lngMinute
If lngHour > 13 And lngHour < 19 Then
MsgBox "è pomeriggio! sbrigati!!"
End If
End Sub
5) codice per criptare (da perfezionare)
Dim x As String
Dim y As String
Dim z As String
Private Sub CommandButton1_Click()
x = Replace(TextBox1.Text, "a", "*")
y = Replace(x, "o", "@")
z = Replace(y, "i", "-")
TextBox1.Text = z
End Sub
Private Sub CommandButton2_Click()
x = Replace(TextBox1.Text, "*", "a")
y = Replace(x, "@", "o")
z = Replace(y, "-", "i")
TextBox1.Text = z
End Sub
Sub CriptaCelle()
For Each c In [B5:B20].Cells
Next
End Sub
Private Sub CommandButton3_Click()
CriptaCelle
End Sub
6) Caselle per GG-MMM-AA – mettere sulla form txt1 e txt2 (invisibili) e cboMese, cboGiorno e cboAnno impostando le proprietà per farle apparire semplici caselle
Private Sub cboAnno_Change()
'If cboAnno.Value = 0 Then cboAnno.Value = ""
If Len(cboAnno) = 1 Then cboAnno.Value = "0" & cboAnno.Value
If Len(cboAnno) > 2 Then cboAnno.Value = Right(cboAnno, 2)
End Sub
Private Sub cboAnno_Enter()
cboAnno.BackColor = &H8000000D
cboAnno.ForeColor = &H80000005
End Sub
Private Sub cboAnno_Exit(ByVal Cancel As MSForms.ReturnBoolean)
cboAnno.BackColor = &H80000005
cboAnno.ForeColor = &H80000008
End Sub
Private Sub cboAnno_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If IsNumeric(cboAnno) Then
cboAnno.SelLength = Len(cboAnno)
If Len(cboAnno) = 3 Then
cboAnno.Value = ""
End If
End If
End Sub
Private Sub cboGiorno_Change()
If cboGiorno.Value = 0 Then cboGiorno.Value = ""
If Len(cboGiorno) = 1 And cboGiorno.Value > 3 Then cboGiorno.Value = "0" & cboGiorno.Value
If Len(cboGiorno) = 2 Then
If cboMese = "gen" Or cboMese = "mar" Or cboMese = "mag" Or cboMese = "lug" Or cboMese = "ago" Or cboMese = "ott" Or cboMese = "dic" Then
If cboGiorno.Value > 31 Then cboGiorno.Value = Right(cboGiorno, 1)
ElseIf cboMese = "feb" Then
If cboGiorno.Value > 29 Then cboGiorno.Value = Right(cboGiorno, 1)
Else
If cboGiorno.Value > 30 Then cboGiorno.Value = Right(cboGiorno, 1)
End If
End If
End Sub
Private Sub cboGiorno_Enter()
cboGiorno.BackColor = &H8000000D
cboGiorno.ForeColor = &H80000005
End Sub
Private Sub cboGiorno_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Len(cboGiorno) = 1 Then cboGiorno.Value = "0" & cboGiorno.Value
cboGiorno.BackColor = &H80000005
cboGiorno.ForeColor = &H80000008
End Sub
Private Sub cboGiorno_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If cboMese = "" Then
cboGiorno.Value = "": cboMese.SetFocus:
MsgBox "Devi selezionare il mese nella casella a sinistra.", vbInformation, "Dati incompleti"
End If
If IsNumeric(cboGiorno) Then
cboGiorno.SelLength = Len(cboGiorno)
If Len(cboGiorno) = 2 Then
cboGiorno.Value = ""
End If
End If
End Sub
Private Sub cboMese_Change()
If cboMese.Value = 0 And txt1 <> "gen" Then
cboMese.Value = ""
ElseIf cboMese.Value = 0 And txt1 = "gen" Then
cboMese.Value = "ott"
ElseIf cboMese.Value = 1 And txt1 = "gen" Then
cboMese.Value = "nov"
ElseIf cboMese.Value = 2 And txt1 = "gen" Then
cboMese.Value = "dic"
ElseIf cboMese.Value = 1 Then
cboMese.Value = "gen"
ElseIf cboMese.Value = 2 Then
cboMese.Value = "feb"
ElseIf cboMese.Value = 3 Then
cboMese.Value = "mar"
ElseIf cboMese.Value = 4 Then
cboMese.Value = "apr"
ElseIf cboMese.Value = 5 Then
cboMese.Value = "mag"
ElseIf cboMese.Value = 6 Then
cboMese.Value = "giu"
ElseIf cboMese.Value = 7 Then
cboMese.Value = "lug"
ElseIf cboMese.Value = 8 Then
cboMese.Value = "ago"
ElseIf cboMese.Value = 9 Then
cboMese.Value = "set"
End If
cboMese.SelStart = 0
'cboMese.SelLength = Len(cboMese)
End Sub
Private Sub cboMese_Enter()
cboMese.BackColor = &H8000000D
cboMese.ForeColor = &H80000005
End Sub
Private Sub cboMese_Exit(ByVal Cancel As MSForms.ReturnBoolean)
cboMese.BackColor = &H80000005
cboMese.ForeColor = &H80000008
End Sub
Private Sub cboMese_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
txt1.Value = cboMese.Value
End Sub
7) Controllare i dati inseriti
Controllare che si scrivano solo Numeri
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsNumeric(TextBox1) = False Then 'se il valore non è un numero
MsgBox "Inserire solo numeri" 'avvisiamo con un messaggio
Cancel = True 'impediamo l'uscita dalla textbox
TextBox1.SelStart = 0 'impostiamo il punto iniziale del valore da selezionare
TextBox1.SelLength = Len(TextBox1) 'selezioniamo tutto il valore contenuto nella textbox1
End If
End Sub
Controllare che si scriva un determinato carattere o insieme di caratteri (testo)
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If InStr(1, TextBox3, "@") = False Then
MsgBox "Indirizzo scritto errato"
Cancel = True
TextBox3.SelStart = 0
TextBox3.SelLength = Len(TextBox3)
End If
End Sub
Controllare che si scriva una data
Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(TextBox4) = False Then
MsgBox "Inserire solo date"
Cancel = True
TextBox4.SelStart = 0
TextBox4.SelLength = Len(TextBox4)
End If
End Sub
Oppure
Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Mid(TextBox4, 3, 1) <> "/" Or Mid(TextBox4, 6, 1) <> "/" Then
MsgBox "Scrivi la data come: 02/10/01"
Cancel = True
TextBox4.SelStart = 0
TextBox4.SelLength = Len(TextBox4)
End If
End Sub
Private Sub CommandButton1_Click()
If Mid(TextBox4, 3, 1) <> "/" Or Mid(TextBox4, 6, 1) <> "/" Then
MsgBox "Scrivi la data come: 02/10/01"
TextBox4 = ""
TextBox4.SetFocus
Exit Sub
End If
...seguono istruzioni di cosa fare se la data è stata scritta giusta
End Sub
Controllare pressione dei tasti (vedi il codice ASCII)
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = 46 Then '46 è il codice Ascii del punto e 44 della virgola
SendKeys ",", False
KeyAscii = 0
End If
End Sub
sostituire virgola con punto
If KeyAscii = 44 Then
SendKeys ".", False
trasferire mentre si digita testo da textbox a cella
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
[A1] = [A1] & Chr(KeyAscii) 'per scrivere in una cella sul foglio attivo
End Sub
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Sheets(x).[A1] = Sheets(x).[A1] & Chr(KeyAscii) 'per scrivere in una cella su un foglio a "distanza" (non attivo)
End Sub
8) Verificare la versione di excel installata
'modo più immediato
Application.version
Public Sub mm()
Dim xlApp As New Excel.Application
Select Case Val(Mid(xlApp.Version, 1, InStr(1, xlApp.Version, ".") - 1))
Case Is = 14
MsgBox "Excel 2010"
Case Is = 12
MsgBox "Excel 2007"
Case Is = 11
MsgBox "Excel 2003"
Case Is = 10
MsgBox "Excel 2002(XP)"
Case Is = 9
MsgBox "Excel 2000"
End Select
End Sub
'Questo invece recupera la versione attiva al momento della chiamata alla funzione:
Public Function fVersioneExcel() As Long
With Application
fVersioneExcel = Val(Mid(.Version, 1, _
InStr(1, .Version, ".") - 1))
End With
End Function
9) Function MiaData da implementare nelle funzioni del foglio o nel codice (anche vb.net)
Public Function MiaData(MyMese, MyAnno)
Select Case MyMese
Case 2
MyMese = "Gennaio-"
Case 3
MyMese = "Febbraio-"
Case 4
MyMese = "Marzo-"
Case 5
MyMese = "Aprile-"
Case 6
MyMese = "Maggio-"
Case 7
MyMese = "Giugno-"
Case 8
MyMese = "Luglio-"
Case 9
MyMese = "Agosto-"
Case 10
MyMese = "Settembre-"
Case 11
MyMese = "Ottobre-"
Case 12
MyMese = "Novembre-"
Case 1
MyMese = "Dicembre-"
MyAnno = MyAnno - 1
End Select
MiaData = MyMese & MyAnno
End Function
10) Funzioni sul foglio
‘formula per verificare voci doppie in intervalli piccoli
=SE(CONTA.SE(D$13:D$25;D19)>1;D19 & " è doppio!";"")
‘restituisce il valore numerico più ricorrente dell’intervallo
=SE(VAL.ERRORE(MODA(L3:L13));"";MODA(L3:L13))
‘formula che evidenzia voci doppie, da incollare nella text della formula di formattaz. condizionale
CONTA.SE(INDIRETTO(CONCATENA(INDIRIZZO(1;RIF.COLONNA(A1);4;1);":";INDIRIZZO(RIF.RIGA(A1)-1
‘ e questo va nella casella [Si applica a] $A$1:$A$25;$B$1:$E$1;$B$2:$B$5
‘formula per tabella zebrata
‘1° regola di formattazione condizionale =SE(RESTO(RIF.RIGA();2)=0;VERO;FALSO)
‘ 2° regola =SE(RESTO(RIF.RIGA();2)<>0;VERO;FALSO)
‘ .. e si applica a =$A$1:$J$27
Google Sites
Report abuse