Corso VBA

[Alexsandra]

Le Funzioni Split, Join, InStr e InStrRev

La Funzione Split
La funzione Split divide una stringa in un numero specificato di sottostringhe e usando un carattere separatore in essa inclusa restituisce tutte le sottostringhe di cui la stringa originale è composta in una matrice unidimensionale in base zero. Sintassi:

Split (expression, delimiter, limit, compare).

È necessario specificare solo l'argomento expression mentre tutti gli altri argomenti sono facoltativi. L'argomento expression è la stringa che verrà divisa in sotto stringhe e delimitata da un carattere contenuto all'interno. Per una stringa di lunghezza zero ("") la funzione restituisce un array vuoto senza elementi.
L’argomento delimiter è il carattere utilizzato per delimitare e separare le sottostringhe e identifica i limiti delle sottostringhe, e se viene omesso, verrà assunto il carattere spazio ("") di default come delimitatore, mentre se è una stringa di lunghezza zero (""), la funzione restituisce l'intera espressione come una matrice a elemento singolo.
L’argomento limit specifica il numero di sottostringhe da restituire e il valore di -1 indica che tutte le sottostringhe vengano restituite.
L’argomento compare specifica il tipo di confronto da utilizzare per valutare le stringhe

È possibile specificare i seguenti argomenti per l’argomento compare:

• vbUseCompareOption (valore: -1) esegue un confronto utilizzando l'impostazione di Option Compare.
• vbBinaryCompare (valore: 0) esegue un confronto binario - confronti tra stringhe basato su un ordinamento
• vbTextCompare (valore: 1) esegue un confronto testuale - confronti tra stringhe che non si basano su un ordinamento testuale case-sensitive
• vbDatabaseCompare (valore: 2) esegue un confronto basato sui dati del database

Se non si specifica l'argomento compare, il confronto viene fatto sulla base Option Compare definita Option Compare Statement, cioè Option Compare Binary oppure Option Compare Text che può essere utilizzato per impostare il metodo di confronto che è necessario specificare a livello di modulo, prima di qualsiasi procedura e se l'Istruzione Option Compare non è specificata, il metodo di confronto testo predefinito è Binary.

Esempio: Estrarre le sotto stringhe utilizzando la funzione Split e riportare la lunghezza e il numero di occorrenze del carattere delimitatore all'interno di una stringa

Sub split1()
Dim test As Variant, varE As Variant, varD As Variant
Dim i As Integer, lungE As Long, lungEx As Long
'stringa che sarà suddivisa in sotto stringhe
varE = "le belle vie del paese"
'delimitatore della stringa
varD = "e"
test = Split(varE, varD)
'Restituisce il numero di elementi nella matrice
MsgBox UBound(test) + 1
'Restituisce 8, il n° di occorrenze del delimitatore all'interno della stringa
MsgBox UBound(test)
For i = LBound(test) To UBound(test)
'riporta ogni elemento della matrice in cui la stringa è divisa
MsgBox test(i)
'ritorna la lunghezza di ogni elemento della matrice
MsgBox Len(test(i))
'riporta la lunghezza totale di tutti gli elementi della matrice
lungE = lungE + Len(test(i))
Next i
'lunghezza della stringa divisa
lungEx = Len(varE)
'calcolare la lunghezza di expression 
If lungEx = UBound(test) * Len(varD) + lungE Then
MsgBox "Uguale"
Else
MsgBox "Diverso"
End If
End Sub

Esempio: Contare e ritornare le parole all'interno di una stringa

Fig. 1

Sub Split2()
Dim testo1 As Variant, varE As Variant, varD As Variant, varP As Variant
Dim i As Integer
'stringa che sarà suddivisa in sotto stringhe - ogni parola è separata da uno spazio
varE = "    Ho visto    un   re anche lui    piangeva.  "
'Indicare lo spazio come delimitatore
varD = " "
'con TRIM si rimuovono tutti gli spazi dal testo ad eccezione dei singoli spazi tra le parole
varE = Application.Trim(varE)
testo1 = Split(varE, varD)
'Restituisce il numero di parole (7) nella stringa 
MsgBox UBound(testo1) + 1
'mettere ogni parola della stringa su righe diverse
For i = 0 To UBound(testo1)
If i = 0 Then
varP = testo1(i)
Else
varP = varP & vbLf & testo1(i)
End If
Next i
'Restituisce ogni parola in una riga separata
MsgBox varP
End Sub

Esempio: Estrarre un elemento di un array, il nome del sito da un indirizzo web o il nome del file dal percorso completo del file.

Sub split3()
Dim testo1 As Variant, varE As Variant, varD As Variant
Dim n As Integer
'stringa da estrarre
varE = "E la luna bussò alle porte del sole"
'Indicare lo spazio come delimitatore di stringhe 
varD = " "
 testo1 = Split(varE, varD)
'Estrarre il terzo elemento della stringa precedente 
n = 3
'Restituisce luna
MsgBox testo1(n - 1)
'Estrarre il terzo elemento della stringa "22,456,7,9824,0" - restituisce 7
MsgBox Split("22,456,7,9824,0", ",")(n - 1)
'indicare sito web
varE = "http://forum.wintricks.it/showthread.php?t=155252"
'Indicare il delimitatore
varD = "/"
testo1 = Split(varE, varD)
'Estrarre il terzo elemento - il nome del sito senza il prefisso http 
n = 3
MsgBox testo1(n - 1)
'Specificare il percorso completo di un file 
varE = "C:\User\Alex\Documents\Excel\VBA\#39.xls"
'Indicare il delimitatore
varD = "\"
testo1 = Split(varE, varD)
'Estrarre l'ultimo elemento - il nome del file 
n = UBound(testo1) + 1
MsgBox testo1(n - 1)
'oppure 
MsgBox testo1(UBound(testo1))
End Sub

Esempio: Sostituire tutte le occorrenze di una stringa in un'espressione stringa con un'altra stringa

Function Rep_1(var As Variant, varF As Variant, varR As Variant, opt1 As Integer) As Variant
    Dim contaF As Integer, arr As Variant
 ‘restituisce una matrice in base zero contenente le sottostringhe. 
arr = Split(var, varF, , opt1)
'Se varF non è stato trovato all'interno di var l'array avrà un solo elemento  
If UBound(arr) < 1 Then
'Ritorno la stringa varr ed esco dalla procedura
Rep_1 = var
Exit Function
Else
'Inizio con una stringa di lunghezza zero
var = ""
'Ciclo per il n° di occorrenze 
For contaF = 1 To UBound(arr)
'Aggiungere ogni elemento (tranne l'ultimo) della matrice con varR
var = var & arr(contaF - 1) & varR
Next contaF
'Aggiungere l'ultimo elemento dell'array dopo tutte le sostituzioni
var = var & arr(UBound(arr))
End If
'Ritorno la stringa finale 
Rep_1 = var
End Function

Sub cambia1()
Dim var As Variant, varF As Variant, varR As Variant, opt1 As Integer
'var è la stringa all'interno della quale varF viene cercato e sostituito da varR
var = "Il mare al tramonto"
'varF è la stringa da cercare all'interno di var 
varF = "a"
'varR è la stringa che sostituisce tutte le istanze di varF in var
varR = "?"
'valore per eseguire il confronto di testo 
opt1 = 1
'Se var è Null, si esce
If IsNull(var) Then
MsgBox "var è nullo, esco dalla procedura"
Exit Sub
'Se var non è Null
Else
'Se uno varF o varRe sono Null o varF è una stringa di lunghezza zero
If IsNull(varF) Or IsNull(varR) Or varF = "" Then
'Ritorno var senza sostituzioni ed esco dalla procedura
MsgBox var
Exit Sub
Else
'Se var, varF e varR non sono Null, eseguo la funzione di sostituzione
MsgBox Rep_1(var, varF, varR, opt1)
End If
End If
End Sub

La Funzione Join
La funzione Join unisce le sottostringhe contenute in una matrice, e restituisce una stringa con le sottostringhe separate da un carattere delimitatore. Sintassi:

Join (sourceArray, delimiter).

È necessario specificare l'argomento sourceArray mentre l’argomento delimiter è facoltativo, ricordare che sourceArray è un array che contiene le sottostringhe che devono essere unite per restituire una stringa e delimiter è il carattere stringa utilizzato per separare le sottostringhe, e se viene omesso, verrà assunto il carattere di spazio ("") di default per essere usato come delimiter, se invece delimiter è una stringa di lunghezza zero (""), la funzione unisce le stringhe senza delimitatore.

Esempio: Utilizzo della funzione JOIN

Sub join1()
Dim arr As Variant, varJ As Variant, varC As Variant
Dim i As Integer
'Definire l’array 
arr = Array("America", "Europa", "Africa", "Asia")
 ‘unire sottostringhe contenute in una matrice
varJ = Join(arr, "&")
'Ritorna la stringa unita 
MsgBox varJ
'Concatenare ogni elemento della matrice
For i = 0 To UBound(arr)
varC = varC & "&" & arr(i)
Next i
'Rimuovere la "&" prima del primo elemento 
varC = Mid(varC, 2)
'String ritorno dopo il concatenamento 
MsgBox varC
End Sub

Esempio: Unire i valori delle celle in un intervallo del foglio di lavoro

Fig. 2

Sub join2()
    Dim rng As Range, riga1 As Integer, colonna1 As Integer, i As Integer
Set rng = ActiveSheet.Range("A2:E4")
Dim varC As Variant
For riga1 = 1 To rng.Rows.Count
For colonna1 = 1 To rng.Columns.Count
If Not rng(riga1, colonna1).Value = vbNullString Then
varC = varC & "," & rng(riga1, colonna1).Value
End If
Next colonna1
'Se l’array è vuoto
If varC = vbNullString Then MsgBox "Array Vuoto": GoTo skip1
'restituisce un record per riga
MsgBox Mid(varC, 2)
varC = ""

skip1:
Next riga1
'Dichiarare una matrice dinamica 
Dim varA() As Variant
Icoll = rng.Columns.Count
i = 0
'Ridimensionare la matrice dinamica 
ReDim varA(Icoll - 1) As Variant
 For riga1 = 1 To rng.Rows.Count
For Icoll = 1 To rng.Columns.Count
If Not rng(riga1, Icoll).Value = vbNullString Then
'Per ogni vbNullString, diminuire il valore dell'indice di matrice
varA(Icoll - 1 - i) = rng(riga1, Icoll).Value
Else
'Contare il numero di vbNullString
i = i + 1
'Se l’array è vuoto
If i = rng.Columns.Count Then MsgBox "Array Vuoto": GoTo skip2
End If
Next Icoll
'Diminuire la dimensione della matrice per numero di vbNullString
ReDim Preserve varA(rng.Columns.Count - 1 - i) As Variant
'restituisce un record per riga
MsgBox Join(varA, ",")

skip2:
'Diminuire la dimensione della matrice per numero di vbNullString
ReDim varA(rng.Columns.Count - 1) As Variant
i = 0
Next riga1 
End Sub

Esempio: Usare le funzioni Split

Sub split2()
Dim newT As Variant, varS As Variant, varD As Variant, varE As Variant, varJ As Variant
Dim i As Integer
 'indirizzo web
varS = "http://forum.wintricks.it/showthread.php?t=155252"
'delimitatore
varD = "/"
'Restituisce un array[/color]
newT = Split(varS, varD)
 ‘mettere ogni elemento della matrice su una riga separata 
For i = 0 To UBound(newT)
If i = 0 Then
'Non inserire una interruzione di linea prima del primo elemento
varE = newT(i)
Else
varE = varE & vbLf & newT(i)
End If
Next i
'Restituisce ogni elemento su una riga separata 
MsgBox varE
'restituisce l'espressione stringa originale
varJ = Join(newT, varD)
MsgBox varJ
End Sub

Esempio: Utilizzo delle funzioni stringa

Sub demo1()
    Dim newT As Variant, varE As Variant, varSE As Variant, varD As Variant, varJ As Variant
Dim Nfile As String, Fdir As String
 'stringa da cui si desidera estrarre un elemento
varE = "Estrarre una sotto espressione dopo aver escluso un elemento da un'espressione"
varD = " "
 ‘restituire una matrice unidimensionale in base zero 
newT = Split(varE, varD)
'Escludere un elemento assegnare il n° dell'elemento (2) a una variabile 
n = 2
For i = 0 To UBound(newT)
If i = n - 1 Then
varSE = varSE
Else
varSE = varSE & "," & newT(i)
End If
Next i
'Rimuovere il primo ","
varSE = Mid(varSE, 2)
MsgBox varSE
'Ridimensionare la matrice per ridurre gli elementi di 1 in modo da escludere l'ultimo elemento 
ReDim Preserve newT(UBound(newT) - 1)
'Unire tutti gli elementi dell'array tranne l'ultimo e aggiungere il . alla fine 
varJ = Join(newT, varD) & "."
'Stringa estratta, escluso l'ultimo elemento
MsgBox varJ
‘indicare il percorso del file [/color]
varE = "C:\User\Alex\Documents\Excel\VBA\pippo.xls"
'Estrarre il nome del file, dal percorso completo del file
Nfile = Mid(varE, InStrRev(varE, "\") + 1)
MsgBox Nfile
'Estrarre il percorso della cartella, escluso il nome del file
Fdir = Left(varE, Len(varE) - Len(Nfile))
MsgBox Fdir
End Sub

La Funzione InStr e InStrRev
La funzione InStr restituisce la posizione (numero di caratteri) in cui una stringa prima si verifica all'interno di un'altra stringa. Sintassi:

InStr (start, string, substring, compare)

ed è necessario specificare gli argomenti string e substring, mentre gli argomenti start e compare sono opzionali.

L'argomento start specifica la posizione (numero di caratteri) all'interno della stringa da cui si desidera iniziare la ricerca per substring, è necessario specificare l'argomento start, se l'argomento di confronto è da specificare e se viene omesso, per impostazione predefinita assumerà il valore 1 (cioè la ricerca partirà dalla prima posizione del carattere). Specificando una posizione di partenza che è maggiore della lunghezza di string verrà restituito il valore 0 (zero), e se start contiene un valore Null si verificherà un errore. L’argomento string è l'espressione stringa all'interno della quale cercare substring, la funzione restituisce 0 se la stringa è di lunghezza zero, e restituisce Null se la stringa è Null. L’argomento substring è l'espressione stringa che viene cercata all'interno della stringa e la cui posizione verrà restituito dalla funzione che restituisce 0 se stringa non viene trovata, oppure restituisce il valore iniziale se la stringa è di lunghezza zero, o restituisce Null se la stringa è Null. L’argomento compare specifica il tipo di confronto da utilizzare per valutare le stringhe.

È possibile specificare i seguenti argomenti per l’argomento compare:

• vbUseCompareOption (valore: -1) esegue un confronto utilizzando l'impostazione di Option Compare.
• vbBinaryCompare (valore: 0) esegue un confronto binario
• vbTextCompare (valore: 1) esegue un confronto testuale - confronti tra stringhe che non si basano su un ordinamento testuale case-sensitive
• vbDatabaseCompare (valore: 2) esegue un confronto basato sui dati del database

Se non si specifica l'argomento compare , il confronto viene fatto sulla base Option definito nella dichiarazione, ricordare che l’istruzione Option Compare (cioè Option Compare Binary o Option Compare Text) può essere utilizzato per impostare il metodo di confronto ed è necessario specificare 'Option Compare Binary' o 'Option Compare Text' a livello di modulo, prima di qualsiasi altra procedura. Se l'Istruzione Option compare non è specificata, il metodo di confronto predefinito è Binary.

La funzione InStrRev Restituisce la posizione della prima occorrenza di una stringa inclusa in un'altra a partire dalla destra della stringa con la seguente sintassi:

InStrRev (string, substring, start, compare)

mentre si utilizzare la funzione InStrRev invece di InStr per cercare nella direzione opposta. È necessario specificare gli argomenti di stringa e sottostringa, mentre gli argomenti start e compare sono opzionali. Se viene omesso l’argomento start, viene utilizzato -1, che significa che la ricerca inizierà dalla posizione dell'ultimo carattere. Tutte le altre spiegazioni e sintassi rimangono invariati rispetto alla funzione InStr.

Esempio: Utilizzo della funzione InStr.

Sub InStrFunc()
    Dim str1 As String, str2 As String
str1 = "Alice vince sempre"
str2 = "e"
'restituisce 5
MsgBox InStr(str1, str2)
str1 = "Alice vince sempre"
str2 = "e"
'restituisce 5
MsgBox InStr(4, str1, str2)
 str1 = "Alice vince sempre"
str2 = "e"
'restituisce 0
MsgBox InStr(24, str1, str2)
str1 = ""
str2 = "e"
'restituisce 0
MsgBox InStr(str1, str2)
 str1 = "Alice vince sempre"
str2 = "i"
'restituisce 3
MsgBox InStr(str1, str2)
Dim str3 As Variant
str1 = "Alice vince sempre"
str3 = Null
'restituisce 1
MsgBox VarType(InStr(str1, str3))
str1 = "Alice vince sempre"
str2 = "s"
'restituisce 13
MsgBox InStr(2, str1, str2)
'restituisce 13
MsgBox InStr(2, str1, str2, 1)
End Sub

Esempio: Sostituire tutte le occorrenze di una stringa in un'espressione stringa con un'altra stringa

Function cambia1(var As Variant, varF As Variant, varR As Variant) As Variant
Dim Lfind As Integer, Pfind As Integer
'Posizione della prima occorrenza di varF, in var
Pfind = InStr(var, varF)
'Lunghezza varF, che sarà sostituito con varR
Lfind = Len(varF)
'Lunghezza RPlen, che sarà sostituito da varF
RPlen = Len(varR)
'Se varF non viene trovato all'interno var 
If Pfind < 1 Then
'si restituisce la stringa var stringa e si esce dalla  procedura
cambia1 = var
Exit Function
'Se varF viene trovato all'interno di var
Else
Do
'Sostituire varF con varR in var
var = Left(var, Pfind - 1) & varR & Mid(var, Pfind + Lfind)
'Posizione della prima occorrenza di varF all'interno di var aggiornato, iniziando  
’ la ricerca dal primo carattere dopo l'ultima sostituzione
Pfind = InStr(Pfind + RPlen, var, varF)
'Se varF non è stato trovato all'interno aggiornato di var, si esce dal ciclo
If Pfind = 0 Then Exit Do
Loop
End If
'Ritorno stringa finale
cambia1 = var
End Function
 
Sub cambia2()
Dim var As Variant, varF As Variant, varR As Variant
'var è la stringa all'interno della quale varF viene cercato e sostituito da varR
 var = "Alice vince sempre"
'varF è la stringa da cercare all'interno di var e che sarà sostituito da varR
varF = "e"
'varR è la stringa che sostituisce tutte le istanze di varF contenute in var
varR = "?"
 'Se var è Null, si esce 
If IsNull(var) Then
MsgBox "var è Null, esco dalla procedura"
Exit Sub
'Se var non è Null
Else
'Se uno tra varF o varR sono Null o varF è una stringa di lunghezza zero[/color]
If IsNull(varF) Or IsNull(varR) Or varF = "" Then
'Ritorno var senza sostituzioni e si esce dalla procedura
MsgBox var
Exit Sub
Else
'Se nessuno tra var, varF e varR sono Null, si esegue la funzione e si sostituiscono tutte le istanze di varF
MsgBox cambia1(var, varF, varR)
End If
End If
End Sub

[Alexsandra]

Manipolare file e Cartelle in VBA

VBA fornisce alcuni metodi per lavorare con i file, ma usando le funzioni di base come Dir, Name etc. che presentano una stretta correlazione di comportamento con i comandi DOS, ma purtroppo riducono notevolmente il raggio d’azione, appesantendo notevolmente il listato del codice. Per estendere le possibilità per quanto riguarda la gestione di file e directory, Microsoft ha sviluppato una serie di oggetti raggruppati all'interno della libreria Microsoft Scripting Runtime, e questo insieme di classe gerarchica ha una sola radice: il FileSystemObject, più comunemente conosciuta come FSO.

Il modello File System Object (FSO) è uno strumento basato sugli oggetti per l'utilizzo di cartelle e file e consente di utilizzare la sintassi oggetto.metodo con un numeroso gruppo di proprietà, metodi ed eventi per l'elaborazione di cartelle e file e inoltre è possibile utilizzare le istruzioni e i comandi tradizionali di Visual Basic. Il FileSystemObject è una manna per tutti gli sviluppatori che utilizzano Visual Basic, in quanto semplifica il compito di trattare con qualsiasi tipo di input e output di file e per interagire con la struttura del file System stesso.

Piuttosto che ricorrere a complesse chiamate alla API Win32, questo oggetto consente alle applicazioni di creare, modificare, spostare ed eliminare cartelle, nonché di rilevare l'esistenza ed eventualmente la posizione di cartelle specifiche, inoltre è possibile ottenere informazioni sulle cartelle, quali il nome, la data di creazione e dell'ultima modifica e così via. Il modello FSO comprende i seguenti oggetti:

Fig. 1

Il modello FSO è contenuto nella libreria dei vari tipi di script, che si trova nel file Scrrun.dll e se non è già presente un riferimento alla libreria, è possibile crearne uno in questo modo: dal menu Strumenti - Riferimenti, e nella scheda che appare scorrere la lista e selezionare la voce Microsoft Scripting Runtime dall'elenco, quindi fare clic su Ok.

Fig. 2

E’ possibile creare un oggetto FileSystemObject utilizzando il metodo CreateObject in questo modo:

oFSO = CreateObject("Scripting.FileSystemObject")

Oppure dimensionando una variabile come oggetto FileSystemObject, in questo modo:

Dim oFSO As New FileSystemObject

I metodi dell’oggetto FSO per le operazioni che può svolgere sono i seguenti:

Fig. 3

Come si può notare, alcune funzioni del modello di oggetti FileSystemObject sono ridondanti, è possibile ad esempio copiare un file tramite il metodo CopyFile dell'oggetto FileSystemObject o tramite il metodo Copy dell'oggetto File. I metodi funzionano in modo identico, sono state esposte entrambe le versioni per offrire la massima flessibilità di programmazione. Non è necessario tuttavia utilizzare i metodi Get con i nuovi oggetti, in quanto se vengono usate le funzioni Create restituiscono già un puntamento a tali oggetti. Se ad esempio viene creata una nuova cartella con il metodo CreateFolder, non è necessario utilizzare il metodo GetFolder per accedere alle sue proprietà, quali Name, Path o Size, è sufficiente impostare una variabile sulla funzione CreateFolder per ottenere un riferimento alla nuova cartella e quindi accedere alle sue proprietà, metodi ed eventi.

Esempio: Visualizzare le informazioni su un file utilizza alcune proprietà di FSO

 Private Sub FileInfo(ByVal fileName As String)
     Dim fso As New FileSystemObject
     Dim fileSpec As File, mInfo As String
     Set fileSpec = fso.GetFile(fileName)
     mInfo = fileSpec.Name & vbCrLf
     mInfo = mInfo & "Creato il: "
     mInfo = mInfo & fileSpec.DateCreated & vbCrLf
     mInfo = mInfo & "Ultimo Accesso: "
     mInfo = mInfo & fileSpec.DateLastAccessed & vbCrLf
     mInfo = mInfo & "Ultima Modifica: "
     mInfo = mInfo & fileSpec.DateLastModified
     MsgBox mInfo, vbInformation, "Informazioni File"
     Set fileSpec = Nothing
End Sub

Che può essere richiamata con un codice come il seguente

Sub info1()
Dim infoF As String
infoF = "C:\Test\info1.txt"
FileInfo (infoF)
End Sub

Esempio: Visualizzare le informazioni su una cartella

 Private Sub FolderInfo(ByVal folderName As String)
     Dim fso As New FileSystemObject
     Dim folderSpec As Folder, mInfo As String
     Set folderSpec = fso.GetFolder(folderName)
     mInfo = folderSpec.Name & vbCrLf
     mInfo = mInfo & "Creata il: "
     mInfo = mInfo & folderSpec.DateCreated & vbCrLf
     mInfo = mInfo & "Dimensione: "
     mInfo = mInfo & folderSpec.Size
     MsgBox mInfo, vbInformation, "Informazioni Cartella"
     Set folderSpec = Nothing
End Sub

Può essere richiamata in questo modo

Sub info2()
Dim infoC As String
infoC = "C:\Test"
FolderInfo (infoC)
End Sub

Esempio: Controllare se una cartella esiste

Function FolderE(DirName As String) As Boolean
On Error Resume Next
FolderE = GetAttr(DirName) And vbDirectory
End Function

La Function sopra riportata può essere testata usando un codice come il seguente

Sub Prova1()
Dim Percorso As String
Percorso = "C:\Test"
MsgBox FolderE(Percorso)
End Sub

Esempio: Controllare se un file esiste

Function FileE(FileName As String) As Boolean
On Error Resume Next
FileE = GetAttr(FileName) And vbArchive
End Function

Che può essere testata in questo modo

Sub Prova2()
Dim FileN As String
FileN = "C:\Test\info1.txt"
MsgBox FileE(FileN)
End Sub

Accedere a un disco
La collezione Drives dell’oggetto FileSystemObject fornisce l'accesso a tutti i record riconosciuti dal sistema operativo e ogni disco è quindi un oggetto ben distinto e il suo ID nella collezione è determinato dalla lettera di accesso (C, D, E, etc.), naturalmente, non si può scrivere, aggiungere o eliminare oggetti in questa collezione. Si deve tenere presente che usando Il metodo DriveExists della classe FileSystemObject è possibile determinare l'esistenza di un disco in base al suo nome.

Dim oFSO As Scripting.FileSystemObject
Dim oDrv As Scripting.Drive
Set oFSO = New Scripting.FileSystemObject
If oFSO.DriveExists("C") Then
    Set oDrv = oFSO.GetDrive("C")
Else
    MsgBox "Questo disco non esiste"
End If

Un'altra possibilità è quella di utilizzare il riferimento diretto alla raccolta Drives

Dim oFSO As Scripting.FileSystemObject
Dim oDrv As Scripting.Drive
Set oFSO = New Scripting.FileSystemObject
If oFSO.DriveExists("C") Then
    Set oDrv = oFSO.Drives("C")
Else
    MsgBox "Questo disco non esiste"
End If

Se il disco non esiste, i due metodi restituiranno lo stesso errore: Errore # 5 chiamata di routine non valido. Attenzione, che con questo metodo si accede ad un disco, o meglio in un disco, ma nel caso si tratti di un’unità CD-Rom e non fosse presente nessun CD non viene generato nessun errore, in sostanza non sappiamo se il dispositivo è accessibile. Esempio: Enumerare tutte le unità disco con un Loop For Each

Dim oFSO As Scripting.FileSystemObject
Dim oDrv As Scripting.Drive
Set oFSO = New Scripting.FileSystemObject
For Each oDrv In oFSO.Drives
    MsgBox oDrv.DriveLetter
Next oDrv

Le Proprietà del disco

• DriveLetter: E’ la lettera utilizzato dal sistema operativo per accedere al disco.
• DriveType: Identifica il tipo di disco, CD-Rom, Disco Fisso, Ramdisk, etc.
• FileSystem: E’ il tipo di file System presente nel disco (es.: NTFS)
• AvailableSpace, FreeSpace: Indica lo spazio disponibile e lo spazio libero in byte
• IsReady: E’ rappresentato da un valore booleano che indica se l'unità è disponibile.
• Path: Indica il percorso del disco.
• RootFolder: Corrisponde alla cartella principale, e fornisce l'accesso a tutti i file presenti sul disco.
• SerialNumber: Indica il numero di serie del disco.
• ShareName: Restituisce una stringa corrispondente alla quota del disco. Questa stringa sarà nulla se il disco non è condiviso.
• VolumeName: Restituisce il nome del volume (non dell'unità) in una stringa. (es.: Dati)
• TotalSize: dimensioni del disco in byte

Alcuni esempi di funzioni per la gestione dei dischi, iniziando dal determinare il numero di CD-ROM (compresi quello virtuale) installato sul Pc:

Function leggiCD1() As Integer
Dim oFSO As Scripting.FileSystemObject
Dim oDrv As Scripting.Drive
Set oFSO = New Scripting.FileSystemObject
For Each oDrv In oFSO.Drives
    If oDrv.DriveType = CDRom Then leggiCD1 = leggiCD1 + 1
Next oDrv
End Function

Esempio: Restituire la lettera del disco rigido con più spazio disponibile

Function leggiD() As String
Dim oFSO As Scripting.FileSystemObject
Dim oDrv As Scripting.Drive
Dim intFree As Double
Set oFSO = New Scripting.FileSystemObject
'Percorso del disco
For Each oDrv In oFSO.Drives
    'Se si tratta di un disco rigido e se contiene un filesystem valido (formattato)
    If oDrv.DriveType = Fixed And oDrv.IsReady Then
        'Se lo spazio libero è superiore a intFree, allora sostituisci
       If oDrv.FreeSpace > intFree Then
            intFree = oDrv.FreeSpace
            leggiD = oDrv.DriveLetter
        End If
    End If
Next oDrv
End Function

Come si può vedere in questo esempio, la manipolazione di oggetti FSO fornisce un codice strutturato nello stesso modo come se si utilizza il metodo DAO (Database.OpenRecordset) in cui lo stesso oggetto viene richiamato più volte. Per questo motivo, è ampiamente raccomandato il refactoring dei blocchi di codice in questo modo.

Function leggiD1() As String
Dim oFSO As Scripting.FileSystemObject
Dim oDrv As Scripting.Drive
Dim intFree As Double
Set oFSO = New Scripting.FileSystemObject
'Percorso del disco
For Each oDrv In oFSO.Drives
    With oDrv
    'Se si tratta di un disco rigido e se contiene un filesystem valido (formattato)
        If .DriveType = Fixed And .IsReady Then
        'Se lo spazio libero è superiore a intFree, allora sostituisci
            If .FreeSpace > intFree Then
                intFree = .FreeSpace
                leggiD1 = .DriveLetter
            End If
        End If
End With
Next oDrv
End Function

Gestione Cartelle
Per accedere a una cartella si osserva lo stesso metodo usato per i dischi, in seguito vedremo i vari metodi e proprietà dell’oggetto cartella. L'accesso a un file istanziando un oggetto Folder, può essere fatto in due modi:

• Direttamente dall'oggetto FSO
• Dalla cartella principale

Prendiamo il caso di un accesso usando FSO e Il metodo GetFolder (path) che restituisce un oggetto Folder, corrispondente al percorso passato come parametro.

Dim oFSO As Scripting.FileSystemObject
Dim oFld As Folder
Set oFSO = New Scripting.FileSystemObject
Set oFld = oFSO.GetFolder("C:\Windows")

Se però la cartella non esiste, verrà restituito un errore 76 (percorso non trovato), per cui è opportuno gestirlo in questo modo.

On Error GoTo err
Dim oFSO As Scripting.FileSystemObject
Dim oFld As Folder
Set oFSO = New Scripting.FileSystemObject
' simulazione errore
Set oFld = oFSO.GetFolder("C:\Windows0") 
fine:
    Exit Function 
err:
    If err.Number = 76 Then
        MsgBox "Questa cartella non esiste"
    Else
        MsgBox "Errore Sconosciuto"
    End If
    Resume fine

Si noti che l'errore 76 può anche essere evitato controllando l'esistenza del file dal FSO con il metodo FolderExists in questo modo

Set oFSO = New Scripting.FileSystemObject
If oFSO.FolderExists("C:\Windows0") Then
    Set oFld = oFSO.GetFolder("C:\Windows0")
Else
MsgBox "Questa cartella non esiste"
End If

Tuttavia, non vi è alcuna garanzia che il file non venga eliminato tra il test di verifica e il tentativo di accesso, per cui è fondamentale gestire l’errore 76 con l’argomento On Error, oppure usando un’altra tecnica che è quella di utilizzare la gerarchia delle cartelle nel file System, in cui ogni oggetto Folder dispone di una proprietà SubFolders per consolidare le sue sottocartelle. Nel caso di C:\Windows, dove Windows rappresenta un “figlio” della cartella C:\ (RootFolder)

Dim oFSO As Scripting.FileSystemObject
Dim oDrv As Drive, oFld As Folder
Set oFSO = New Scripting.FileSystemObject
Set oDrv = oFSO.GetDrive("C")
Set oFld = oDrv.RootFolder.SubFolders("Windows")

Anche se a prima vista il codice sembra più complesso, o più pesante, poiché l'accesso al disco è separato dal file, con questo metodo saremo in grado di conoscere il livello di errore in caso di mancata esecuzione, in altre parole, è l'unità C, che non è disponibile o inesistente su Windows? Possiamo gestirlo in questo modo:

On Error GoTo err
Dim oFSO As Scripting.FileSystemObject
Dim oDrv As Drive, oFld As Folder
Set oFSO = New Scripting.FileSystemObject
Set oDrv = oFSO.GetDrive("C")
Set oFld = oDrv.RootFolder.SubFolders("Windows")
fine:
    Exit Function
err:
        Select Case err.Number
            Case 5: MsgBox "Il disco non è disponibile"
            Case 76: MsgBox "Il record non esiste in questo disco"
            Case Else: MsgBox "Errore sconosciuto"
        End Select
    Resume fine

Come per l'accesso, è possibile utilizzare due diverse tecniche per creare una cartella:

• Utilizzando direttamente l'FSO
• Utilizzando un oggetto Folder tramite la sua collezione SubFolders

Usando FSO si può fare con questo codice:

On Error GoTo err
Dim oFSO As Scripting.FileSystemObject
Dim oDrv As Drive, oFld As Folder
Set oFSO = New Scripting.FileSystemObject
Set oFld=oFSO.CreateFolder ("C:\Test")
fine:
    Exit Function 
err:
        Select Case err.Number
            Case 58: MsgBox "Il file esiste già"
            Case 76: MsgBox "Percorso non corretto"
            Case Else: MsgBox "Errore sconosciuto"
        End Select
    Resume fine

Se il percorso non è valido, o la directory principale del disco è inesistente, viene generato un errore 76 (percorso non trovato), mentre se il file esiste già, l'operazione non riesce e rimanda un errore 58 (File già esistente). L'oggetto Ofld restituito dal metodo CreateFolder è riutilizzabile immediatamente dopo il codice, dal momento che la collezione SubFolders viene usata in questo modo:

On Error GoTo err
Dim oFSO As Scripting.FileSystemObject
Dim oDrv As Drive
Set oFSO = New Scripting.FileSystemObject
Set oDrv = oFSO.GetDrive("C")
oDrv.RootFolder.SubFolders.Add ("Test")
fine:
    Exit Function
err:
        Select Case err.Number
            Case 5: MsgBox "Il disco non è disponibile"
            Case 58: MsgBox "Il file esiste già"
            Case 76: MsgBox "Percorso non corretto"
            Case Else: MsgBox "Errore sconosciuto"
        End Select
    Resume fine

Come si può vedere dal codice, la differenza sta solo nella gestione degli errori. Per chi ha familiarità con DAO, probabilmente si ricorderà la proprietà Attributes per oggetti diversi che rappresenta l'aggiunta logica dei diversi valori degli elementi di qualificazione. Ad esempio, una cartella potrebbe essere nascosta, oppure nascosta e archiviata, etc. I valori possibili sono:

• Normal
• ReadOnly: Sola lettura
• Hidden: Cartella nascosta
• System: Cartella Sistema
• Archive: archivio di file
• Compressed: Cartella compressa

Di seguito sono riportati alcuni possibili listati di prova:

If oFld.Attributes And Directory Then MsgBox "Nascosto"
If oFld.Attributes And (Hidden + ReadOnly) Then MsgBox "Nascosta e di sola lettura"

La proprietà Attributes può essere applicata in lettura o in scrittura, il che significa che è possibile modificare gli attributi di cartella. Esempio per rimuovere una modalità cartella nascosta:

If oFld.Attributes And Hidden Then
 oFld.Attributes = oFld.Attributes - Hidden
End If

Le proprietà dell'oggetto Folder

• Attributes: Come visto sopra, attribuisce la cartella.
• DateCreated: Data di creazione della cartella
• DateLastAccessed: Data dell'ultimo accesso alla cartella
• DateLastModified: Data ultima modifica
• Drive: Corrispondente al disco in cui si trova la cartella
• Files: E’ una raccolta di file nella cartella
• IsRootFolder: E’ un valore booleano che determina se la cartella è la radice del disco
• Name: Indica il nome della cartella
• ParentFolder: Folder corrisponde alla cartella principale, se la cartella è una cartella RootFolder questa proprietà restituisce Nothing.
• Path: Indica il percorso completo della cartella
• ShortName: E’ il nome “breve” di una cartella con un massimo di 8 caratteri
• ShortPath: percorso completo della cartella in cui ogni componente è conforme alla norma ShortName
• Size: Dimensione totale del file in byte. Questa è la somma delle dimensioni di tutti i file nella cartella e relative sottocartelle.
• SubFolders: Indica un raggruppamento di sottocartelle
• Type: Tipo di file. In tutti i casi esaminati, è FileFolder

Il metodo Copy dell'oggetto Folder
Il metodo Copy consente di copiare la cartella e il suo contenuto in un altro percorso (esistenti o meno). Sintassi: Copy(Destination As String, [OverWriteFiles As Boolean = True]). Dove Destination rappresenta un percorso valido di destinazione della copia e se OverWriteFiles è vero, i file presenti nella directory di destinazione vengono sovrascritti se hanno lo stesso nome. Esempio: oFld.Copy "C:\Test", True

Se il percorso di destinazione non è corretto, viene generato un errore 76 (percorso non trovato) e se OverWriteFiles è False e la destinazione contiene già dei file con lo stesso nome, viene generato un errore 58 (File già esistente). Il metodo CopyFolder dell’oggetto FSO riproduce lo stesso comportamento. Esempio: oFSO.CopyFolder("C:\Test","C:\Test2",True)


Il metodo Delete dell’oggetto Folder
Il metodo Delete rimuove la cartella specificata. Sintassi: Delete([Force As Boolean = False]). Il parametro Force se viene collocato a True esegue una forzatura per eliminare file di sola lettura nella cartella specificata e relative sottocartelle. Se invece Force è False, viene generato un errore 70 (Permesso negato) e il file diventa di sola lettura, e vale anche se il file è aperto. Esempio: oFld.Delete False

E 'possibile utilizzare un altro metodo per eliminare una cartella usando il metodo DeleteFolder dell’oggetto FileSystemObject. Esempio: oFSO.DeleteFolder "C:\Test", False


Il metodo Move dell’oggetto Folder
Il metodo Move sposta la cartella di destinazione specificata in un altro percorso. Sintassi: Move(Destination As String). Esempio: oFld.Move "C:\Test2"

E 'possibile spostare una cartella in un'altra, tuttavia, inoltre se il contenuto esiste già nella destinazione verrà generato un errore 58. Anche in questo caso, si può utilizzare l’equivalente FSO con il metodo MoveFolder. Esempio: oFSO.MoveFolder "C:\Test", "C:\Testi2"


Cartelle speciali
Il metodo GetSpecialFolder consente l'accesso a directory specifiche. Sintassi: GetSpecialFolder(SpecialFolder As SpecialFolderConst) As Folder e i valori possibili per SpecialFolder sono:

• WindowsFolder: Cartella in cui è installato Windows
• SystemFolder: Cartella di Sistema (Windows)
• TemporaryFolder: Cartella per memorizzare i file temporanei

Gestione dei file
Questa è la gerarchia più bassa dell'elemento e ogni file è rappresentato da un oggetto file nell'insieme Files in un oggetto Folder. Per accedere a un file si possono essere utilizzati due metodi per restituire un oggetto File.

• Utilizzando il metodo GetFile del FileSystemObject
• Utilizzando la collezione File di un oggetto Folder

Usando FSO può essere espresso in questo modo

On Error GoTo err
Dim oFSO As Scripting.FileSystemObject
Dim oFl As Scripting.File
Set oFSO = New Scripting.FileSystemObject
Set oFl = oFSO.GetFile("C:\Test\info1.txt")
fine:
    Exit Function  
err:
        Select Case err.Number
            Case 53: MsgBox “Il file non è stato trovato"
            Case Else: MsgBox "Errore sconosciuto"
        End Select
    Resume fine

Si deve prestare attenzione che se il percorso del file non è corretto, viene generato l'errore 53 (File non trovato). In questi casi viene usato il metodo FileExists per verificare l'esistenza del file.

On Error GoTo err
Dim oFSO As Scripting.FileSystemObject
Dim oFl As Scripting.File
Set oFSO = New Scripting.FileSystemObject
If oFSO.FileExists("C:\Test\info1.txt") Then
    Set oFl = oFSO.GetFile("C:\Test\info1.txt")
End If
fine:
    Exit Function
err:
        Select Case err.Number
            Case 53: MsgBox “Il file non è stato trovato"
            Case Else: MsgBox "Errore Sconosciuto"
        End Select
    Resume fine

Mentre usando l’oggetto Folder il codice è il seguente:

On Error GoTo err
Dim oFSO As Scripting.FileSystemObject
Dim oFld As Scripting.Folder
Dim oFl As Scripting.File
Set oFSO = New Scripting.FileSystemObject
Set oFld = oFSO.GetFolder("C:\Test")
Set oFl = oFld.Files("info1.txt")
fine:
    Exit Function
err:
        Select Case err.Number
            Case 76: MsgBox "La cartella non esiste"
            Case 53: MsgBox "Il file non si trova in questa cartella"
            Case Else: MsgBox "Errore Sconosciuto"
        End Select
    Resume fine

Le proprietà dell'oggetto File

• Attributes: Gli attributi dei file, stessa proprietà per le cartelle.
• DateCreated: Data di creazione del file
• DateLastAccessed: Data dell'ultimo accesso
• DateLastModified: Data ultima modifica
• Drive: Indica l’unità corrispondente al disco in cui risiede il file
• Name: Nome del file.
• ParentFolder: E’ la Cartella che contiene il file.
• Path: Indica il percorso completo del file.
• ShortName: Denominazione rispettando lo standard 8.3 (8 caratteri per il nome e 3 per l'estensione).
• ShortPath: Percorso completo della cartella in cui ogni componente è conforme alla norma ShortName
• Size: Dimensione in byte del file
• Type: Tipo di file

Il metodo Copy dell'oggetto File
Il metodo copy permette di copiare il file in un'altra destinazione. Sintassi: Copy(Destination As String, [OverWriteFiles As Boolean = True])

Dove Destination è un percorso valido del file copiato, e se esiste già un file con lo stesso nome, verrà sovrascritto con l'unica condizione che OverWriteFiles sia uguale a true. Esempio: oFl.Copy "C:\Test2\info1.txt", True

Se il percorso di destinazione non è corretto, viene generato un errore 76 (percorso non trovato). Se invece OverWriteFiles è uguale a False e il file esiste già, viene generato un errore 58 (File già esistente). Il metodo CopyFile dell’oggetto FSO riproduce lo stesso comportamento. Esempio: oFSO.CopyFile("C:\Test\info1.txt","C:\Test2\info1. txt ",True)


Il metodo Delete dell’oggetto File
Il metodo Delete elimina il file specificato. Sintassi: Delete([Force As Boolean = False]), dove il parametro Force se posto uguale a True, forza l’eliminazione di un file anche se è di sola lettura, se invece è uguale a False e il file è di sola lettura, viene generato un errore 70 (Autorizzazione negata). Questo errore viene generato se il file è aperto. Esempio: oFl.Delete False. È anche possibile utilizzare il metodo DeleteFile per l’oggetto FSO. Esempio: oFSO.DeleteFile "C:\Test\info1.txt", False


Il metodo Move dell’oggetto File
Il metodo Move permette di spostare il file in un'altra destinazione. Sintassi: Move(Destination As String). Esempio: oFl.Move "C:\Test2\info1.txt". In alternativa, si può usare il metodo MoveFile dell’oggetto FileSystemObject. Esempio: oFSO.MoveFile "C:\Test\info1.txt ", "C:\Test2\info1.txt "

Questi metodi possono essere usati anche per rinominare un file.
Esempio: oFSO.MoveFile "C:\Test\info1.txt ", "C:\Test\info1_old.txt "


Verificare l'esistenza di un percorso
Sebbene il FileSystemObject fornisce diversi metodi per verificare l'esistenza di un file, è difficile in caso di errore sapere quale parte del percorso ha causato il problema in caso di errore. Immaginate questo percorso: C:\Test\Test2\Prove3 dove Prove3 non esiste. Usando il metodo FolderExists viene restituito il valore di False, ma l'utente ignorerà se è stato causato da Test, Test2 o Prove3. In questo caso si può usare una funzione più completa per identificare il file alla radice dell'errore.

Function TestC(strC As String) As Boolean
On Error GoTo err
Dim oFSO As Scripting.FileSystemObject, oFld As Scripting.Folder
Dim oDrv As Scripting.Drive, i As Integer
Dim strD() As String
'istanziare FSO
Set oFSO = New Scripting.FileSystemObject
'Accedere al disco
Set oDrv = oFSO.Drives(oFSO.GetDriveName(strC))
'Instanziare la cartella principale
Set oFld = oDrv.RootFolder
'tagliare il percorso della cartella
strD = Split(strC, "\")
'tentativi di accedere alle sotto cartelle
For i = 1 To UBound(strD) - 1
    Set oFld = oFld.SubFolders(strD(i))
Next i
TestC = True
fine:
    Exit Function
err:
    Select Case err.Number
        Case 5: MsgBox "Il disco non esiste"
        Case 76: MsgBox "Impossibile trovare il file: " & strD(i)
        Case Else: MsgBox "Errore Sconosciuto"
    End Select
    Resume fine
End Function

[Alexsandra]

Le Funzioni Empty – ZLS – Null – Nothing e Missing

In Excel VBA spesso ci riferiamo a una variabile Empty (vuota), a una ZLS (stringa di lunghezza zero) o a una stringa nulla (vbNullString), a un valore Null o a un argomento mancante (Missing) o utilizzando la parola chiave Nothing (Niente) con una variabile oggetto. E 'importante differenziare e comprendere questi termini ed espressioni mentre vengono utilizzati nel codice VBA. Vediamo ora di comprendere come utilizzare la funzione VarType per determinare il sottotipo di una variabile, utilizzando le funzioni IsEmpty e IsNull per verificare la presenza di valori vuoti, e la funzione IsMissing per verificare se gli argomenti opzionali sono stati elencati nella procedura.


La Funzione Empty
Quando si dichiara una variabile utilizzando un'istruzione Dim, si sta riservando la parte sufficiente di memoria per alloccare la variabile nel sistema, (cioè 2 byte per una variabile booleana o Integer, 4 byte per una variabile Long, e così via), e inoltre ci si deve accertare che le informazioni che saranno memorizzate nella variabile abbiano un intervallo consentito (True o False per una variabile booleana, un numero intero compreso tra -32.768 e 32.767 per una variabile Integer, un numero intero compreso tra -2.147.483.648 a 2.147.483.647 per una variabile Long, e così via ).

Quando in una dichiarazione di una variabile non si specifica il tipo di dati, oppure se non viene dichiarata, assumerà per impostazione predefinita la forma di tipo Variant e può contenere qualsiasi tipo di dati (stringa, data, ora, booleano o valori numerici) e sarà in grado di convertire automaticamente i valori che contiene. Tuttavia, lo svantaggio di questa assegnazione è che deve essere riservata più memoria di quanto richiesto (almeno 16 byte), oltre al fatto che in caso di un errore di digitazione di un nome di variabile non saremmo in grado di riconoscerlo, vale a dire che è possibile digitare rowNumbre invece di rowNumber.

Quando si esegue una macro, tutte le variabili vengono inizializzate ad un valore predefinito e Il valore di default iniziale per una variabile numerica è zero, per una stringa di lunghezza variabile è una lunghezza zero o stringa vuota (""), una stringa di lunghezza fissa viene inizializzata con il codice ASCII 0, o Chr (0), una variabile oggetto su Nothing e una variabile Variant viene inizializzata a vuoto. Nel contesto numerico, una variabile vuota indica uno zero, mentre in un contesto di una variabile stringa vuota è una stringa di lunghezza zero ("") che è indicata anche come una stringa nulla. Tuttavia, si consiglia di specificare esplicitamente un valore iniziale per una variabile, invece di basarsi sul suo valore iniziale di default.


La Funzione IsEmpty
Si può utilizzare la funzione IsEmpty per controllare se una variabile è stata inizializzata, in questo caso la funzione restituisce un valore booleano, restituisce True per una variabile non inizializzata o se una variabile è impostata in modo esplicito a Empty, altrimenti la funzione restituisce False. La sintassi è la seguente: IsEmpty (espressione), dove espressione è una variabile di tipo Variant che si desidera controllare.


La Funzione ZLS (stringa di lunghezza zero) o vbNullString
ZLS significa stringa di lunghezza zero (""), ed è indicata anche come una stringa nulla, e ha una lunghezza pari a zero (0). Per tutti gli scopi pratici si può utilizzare la costante vbNullString che è equivalente a una stringa di lunghezza zero (""), perché VBA interpreta in un modo simile, anche se entrambi non sono in realtà la stessa cosa, in quanto una stringa di lunghezza zero significa in realtà la creazione di una stringa senza caratteri, mentre vbNullString è una costante utilizzata per un puntatore nullo il che significa che nessuna stringa viene creata ed è anche più efficiente o più veloce da eseguire rispetto a ZLS. È possibile usare "" o vbNullString in alternativa nel codice ed entrambi si comportano allo stesso modo, si noti che non vi è alcuna parola chiave Empty in VBA, ma possiamo fare riferimento a "celle vuote "o "celle vuote nel foglio di calcolo Excel”.


La Funzione VarType
Si utilizza la funzione VarType per determinare il tipo di variabile con la seguente sintassi: VarType (nome_variabile) e restituisce un intero che indica il sottotipo della variabile. L’espressione nome_variabile può essere qualsiasi variabile, tranne un tipo di dati definito dall'utente utilizzando l'istruzione Type. Esempi di valori di ritorno sono:

Il valore 0 (costante VarType - vbEmpty, non inizializzato di default), il valore 1 (costante VarType - vbNull, non contiene dati validi), il valore 2 (costante VarType - vbInteger, Integer), il valore 3 (costante VarType - vbLong, Intero long), e così via. Le costanti VarType possono essere utilizzate ovunque nel codice al posto dei valori effettivi.

Esempio: Rappresentare una variabile vuota:

Sub Prova1 () 
'la variabile Var1 non è stata dichiarata, quindi è di tipo Variant
'e restituisce 0, che indica come sottotipo una variabile vuota
MsgBox VarType (var1)
'restituisce True, che indica una variabile vuota
MsgBox IsEmpty (var1)
'restituisce False, è una variabile vuota, non una variabile Null
MsgBox IsNull (var1)
'una variabile vuota o uguale a zero in VBA viene rappresentata sia come uno zero
‘che come una stringa di lunghezza zero, e restituisce entrambi i messaggi
If var1 = 0 Then
MsgBox "Variabile vuota rappresentata come Zero"
End If
If var1 = "" Then
MsgBox "Variabile vuota rappresentata come Zero-Length (Null) String"
End If
End Sub

Esempio: Test per variabili vuote

Sub Prova2 () 
Dim var1 As Variant
'variabile non inizializzata, restituisce 0, che indica una variabile vuota
MsgBox VarType (var1)
'restituisce True, indicando una variabile vuota
MsgBox IsEmpty (var1)
'Inizializzare la variabile come stringa
var1 = "Ciao"
‘restituisce 8, che indica una variabile Stringa
MsgBox VarType (var1)
'restituisce False, che indica che la variabile non è vuota
MsgBox IsEmpty (var1)
'si imposta la variabile vuota
var1 = Empty 
'restituisce 0, che indica variabile vuota
MsgBox VarType (var1)
'restituisce True, che indica variabile vuota
MsgBox IsEmpty (var1)
'Restituisce True per una cella del foglio di lavoro vuota, altrimenti False
MsgBox IsEmpty (ActiveCell)
End Sub

Esempio: Inizializzare una variabile Variant

Sub Prova3 () 
Dim var1 As Variant
'variabile inizializzata con una stringa di lunghezza zero ("")
var1 = ""
'restituisce False, che indica che la variabile non è vuota
MsgBox IsEmpty (var1)
‘restituisce 8, che indica una variabile Stringa 
MsgBox VarType (var1)
If var1 = "" Then
MsgBox "Il valore della variabile è una stringa di lunghezza zero"
Else
MsgBox "Il valore della variabile NON è una stringa di lunghezza zero"
End If
If var1 = 0 Then
MsgBox "Il valore della variabile è zero"
Else
MsgBox "Il valore della variabile non è zero"
End If
End Sub

Esempio: Controllare una stringa di lunghezza zero:

Sub Prova4 () 
Dim var1 As Variant
'variabile non inizializzata, restituisce 0, che indica una variabile vuota
‘è rappresentata sia come zero (0) che con una lunghezza zero (Null)
MsgBox VarType (var1)
If var1 = "" Then
MsgBox "True"
End If
If var1 = vbNullString Then
MsgBox "True"
End If
If Len (var1) = 0 Then
MsgBox "True"
End If
End Sub

La funzione Null
In VBA, la parola chiave Null viene utilizzata per indicare che una variabile non contiene dati validi e il valore che indica una variabile che non contiene dati validi il risultato è Null se:

• Si assegna esplicitamente Null a una variabile
• Se si eseguono operazioni tra espressioni che contengono la parola chiave Null

La parola chiave Null viene utilizzata per variabili di tipo Variant, e solo una variabile Variant può essere Null, mentre variabili di qualsiasi altro tipo rimanderanno un errore, inoltre una variabile Null non è da intendere come una stringa di lunghezza zero (""), e non è vuota, ma indica una variabile non ancora inizializzata. Se si tenta di ottenere il valore di una variabile Null o un'espressione che è Null, si otterrà un errore 94 di Utilizzo non valido di Null.


La Funzione IsNull
La funzione IsNull restituisce un valore booleano, dove True rappresenta un'espressione che Null (non contiene dati validi), mentre False indica un'espressione che contiene dati validi. La sintassi è la seguente: IsNull (espressione) e l'argomento espressione è una variante che contiene un valore numerico o stringa.

Esempio: Variabile Integer

Sub Prova5 () 
'nessun valore iniziale è assegnato alla variabile Integer
Dim intVar As Integer
'Restituisce False (intVar non è Null o Empty) 
MsgBox IsNull (intVar)
'restituisce 2, indicando il tipo Integer
MsgBox VarType (intVar)
If intVar = 0 Then
MsgBox "Il valore della variabile è zero"
Else
MsgBox "Il valore della variabile non è zero"
End If
End Sub

Esempio: Valutare se la variabile è Empty o Null

Sub Prova6 () 
Dim var1 As Variant
'restituisce False, var1 non è Null, ma è vuota 
MsgBox IsNull (var1)
'la variabile non è inizializzata e restituisce 0, che indica una variabile vuota
MsgBox VarType (var1)
'restituisce il messaggio perché var1 è una variabile vuota
If var1 = 0 And var1 = vbNullString Then
MsgBox "Variabile vuota rappresentata sia come zero (0) che come lunghezza zero (Null) String"
End If
'la variabile viene inizializzata su una stringa di lunghezza zero ("") o vbNullString
var1 = vbNullString
'restituisce False, var1 non è una variabile Null
MsgBox IsNull (var1)
‘restituisce 8, che indica una variabile stringa
MsgBox VarType (var1)
'si assegna Null alla variabile
var1 = Null
'restituisce True, una variabile Null, non contenente dati validi
MsgBox IsNull (var1)
'restituisce 1, indicando una variabile Null
MsgBox VarType (var1)
'assegnare dei dati validi alla variabile
var1 = 12
'restituisce False, per una variabile che contiene dati validi
MsgBox IsNull (var1)
'restituisce 2, indicando una variabile integer
MsgBox VarType (var1)
'restituisce False, per un'espressione contenente dati validi
MsgBox IsNull ("Ciao")
End Sub

Esempio: Controllare una variabile Null

Sub Prova7 () 
'si assegna Null alla variabile
var1 = Null
'restituisce 1, indicando una variabile NUll
MsgBox VarType (var1)
'restituisce il messaggio, indicando una variabile Null
If VarType (var1) = vbNull Then
MsgBox "Variabile Null"
End If
'un'espressione contenente Null restituisce ancora Null
var2 = Null + 2
'restituisce 1, indicando una variabile Null
MsgBox VarType (var2)
End Sub

Esempio: Controllare una cella del foglio di lavoro

Sub Prova8 ()  
Dim var1 As Variant
'restituisce True
MsgBox vbNullString = ""
'se  ActiveCell è vuota restituisce True 
MsgBox ActiveCell.Value = ""
MsgBox ActiveCell.Value = vbNullString
MsgBox ActiveCell.Value = 0
MsgBox IsEmpty (ActiveCell.Value)
'assegnare il valore della cella attiva alla variabile
var1 = ActiveCell.Value
'restituisce True
MsgBox IsEmpty (var1)
MsgBox var1 = vbNullString
MsgBox var1 = ""
MsgBox var1 = 0
'restituisce False
MsgBox VarType (var1) = vbNull
'restituisce 0, che indica una variabile vuota
MsgBox VarType (var1)
'se si immette "" nella cella attiva restituisce True
MsgBox ActiveCell.Value = ""
MsgBox ActiveCell.Value = vbNullString
'restituisce False
MsgBox ActiveCell.Value = 0
MsgBox IsEmpty (ActiveCell.Value)
End Sub

La Funzione Nothing
L’assegnazione della parola chiave Nothing a una variabile oggetto dissocia la variabile stessa da un oggetto reale e questa assegnazione avviene utilizzando l'istruzione Set. Abbiamo visto in precedenza che ogni assegnazione eseguita a delle variabili vengono utilizzate delle risorse di sistema per allocare in memoria la variabile. Le risorse di sistema e di memoria vengono rilasciati solo dopo aver assegnato Nothing tramite l’istruzione Set a tutte le variabili oggetto che di dissociare queste variabili dall'oggetto reale, o quando tutte le variabili oggetto vengono distrutte. Si consiglia di impostare esplicitamente tutte le variabili oggetto a Nothing al termine della procedura o anche prima durante l'esecuzione, quando il codice ha finito di usarle, e questo rilascerà memoria allocata per queste variabili.

Per controllare se un oggetto è stato assegnato o impostato, si utilizza la parola chiave IsNothing, vale a dire usando un’espressione come la seguente: If object_variable Is Nothing

Esempio: Utilizzare la parola chiave Nothing con una variabile oggetto

 Sub Prova9()
Dim OVar As Object
'restituisce True, perché non è stato assegnato un oggetto reale alla variabile oggetto
MsgBox OVar Is Nothing
Set OVar = ActiveSheet
'restituisce False, perché è stato assegnato un oggetto reale (foglio) alla variabile
MsgBox OVar Is Nothing
Set OVar = Nothing
'restituisce "La variabile non è associata a un oggetto reale", perché abbiamo dissociato
'la variabile oggetto da un oggetto reale
If OVar Is Nothing Then
MsgBox "La variabile non è associata a un oggetto reale"
Else
MsgBox "Un oggetto reale è assegnato a una variabile Object"
End If
End Sub

La funzione Missing
Quando un valore esterno deve essere utilizzato da una procedura per eseguire un'azione, si passa alla procedura da variabile che sono chiamati argomenti. Un argomento è il valore fornito dal codice chiamante a una procedura quando viene chiamato e quando il set di parentesi, dopo il nome della procedura nella dichiarazione Sub o Function, è vuota, si tratta di un caso in cui la procedura non riceve argomenti. Tuttavia, quando gli argomenti sono passati a una procedura da altre procedure, allora questi sono elencati o dichiarati tra le parentesi.

Gli argomenti possono essere specificati come facoltativi, utilizzando la parola chiave Optional prima dell’argomento alla sua sinistra e quando si specifica un argomento come opzionale, tutti gli altri argomenti successivi posti alla destra dell’argomento sono specificati come Optional. Si noti che specificando la parola chiave Optional rende un argomento opzionale altrimenti sarà richiesto l'argomento.

L'argomento opzionale dovrebbe essere (anche se non è necessario) dichiarato come tipo di dati Variant per consentire l'uso della funzione IsMissing che funziona solo quando viene utilizzato con le variabili dichiarate come Variant. La funzione IsMissing viene utilizzata per determinare se l'argomento opzionale è stato passato alla procedura o meno in modo che ci si può regolare di conseguenza nel codice senza restituire un errore. Se l'argomento opzionale non è dichiarato come Variant, la funzione IsMissing non funziona, e all'argomento opzionale verrà assegnato il valore predefinito per il tipo di dati che è 0 per le variabili di tipo numerico (cioè Integer, Double, ecc) e Nothing (un riferimento nullo) per le variabili String o variabili di tipo Object.

La funzione IsMissing viene utilizzata con questa sintassi: IsMissing (argname) e restituisce un valore booleano, True se non viene passato nessun valore per l'argomento opzionale, e False se un valore è stato passato. Se la funzione IsMissing restituisce True per un argomento, utilizzando l'argomento mancante nel codice causerà un errore, e quindi utilizzando questa funzione aiuterà a regolare il codice di conseguenza.

Esempio: Utilizzo della funzione IsMissing per verificare se un argomento è mancante

 Function NomeC(Pnome As String, Optional Snome As Variant) As String
'La dichiarazione della procedura contiene due argomenti, il secondo argomento è specificato come Optional. ‘Dichiarare l'argomento opzionale come tipo di dati Variant consentirà l'utilizzo della funzione IsMissing.
If IsMissing(Snome) Then
NomeC = Pnome
Else
NomeC = Pnome & "" & Snome
End If
End Function
 
 Sub Pas_Nome()
 Dim nome1 As String
 nome1 = InputBox("Inserire il nome")
 'Specificando solo il primo argomento e omettere il secondo argomento che è facoltativo
MsgBox NomeC(nome1)
End Sub

[Alexsandra]

Invio di una e-mail utilizzando un server remoto con CDO

Il funzionamento di un servizio di posta elettronica è garantito dalla collaborazione di tre distinti software: un server che si occupa della consegna dei messaggi (protocollo SMTP), un server che riceve i messaggi, li archivia e li trasmette, su richiesta, al titolare della casella (protocollo POP3 o IMAP) e un client che, dal PC dell'utente, è in grado di inviare e ricevere e-mail collegandosi e dialogando con le due parti server del servizio. I Web server non offrono funzionalità di posta elettronica, tuttavia le macchine che ospitano servizi Web, spesso e volentieri, permettono anche l'invio delle e-mail, tramite un apposito server SMTP.

A partire dalla versione Windows NT/2000, è stata integrata una libreria COM, chiamata CDO, che è l’acronimo di Collaboration Data Object, contenuta nel file Cdosys.dll, e permette di spedire e-mail attraverso il protocollo SMTP (Simple Mail Transfert Protocol) del Sistema Operativo, senza alcun bisogno di utilizzare un client. Vedremo come è possibile sfruttare il server SMPT presente nel sistema per inviare e-mail generate dinamicamente aiutandoci con qualche esempio.

Esempio 1: Inviare una e-mail utilizzando Gmail.
Per poter utilizzare gli oggetti della libreria CDO è innanzitutto indispensabile istanziare tali oggetti. In questo esempio useremo solo l’oggetto CDO.Message in cui verrà definito il messaggio stesso e per istanziare l’oggetto useremo il comando: Set cdoMess = CreateObject("CDO.message"). La routine completa è la seguente

Sub inviaE()
'istanza dell'oggetto CDO
Set cdoMess = CreateObject("CDO.message")

'Impostare i parametri di configurazione del server remoto
With cdoMess.Configuration.Fields
‘Indicare come il messaggio deve essere inviato. I valori sono:
‘1 – Si utilizza questo valore se il servizio SMTP è installato nel computer in cui lo script è in esecuzione.
‘2 – Si utilizza questo valore se il servizio SMTP non è installato nel computer in cui lo script è in esecuzione.
  .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Impostare il server SMTP che si utilizza
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
'Impostare la porta di comunicazione del server SMTP
  .Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 587
'Abilitare autenticazione SMTP, il valore 1 indica True 
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
‘Abilita autenticazione SSL 
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
‘Timeout di connessione in secondi (il tempo massimo in cui CDO tenterà di stabilire una connessione al server SMTP
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
'Impostare le credenziali del vostro account Gmail
  .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "prova@gmail.com"
  .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "pass1234"
'Aggiorna i campi di configurazione  
  .Update
End With

’Proprietà del messaggio
With cdoMess
‘Inserire l’indirizzo del destinatario. E’ possibile inserire più indirizzi separandoli con una virgola
  .To = info.prova@gmail.com
‘Inserire il nominativo del mittente della e-mail
  .From = prova@gmail.com
‘Inserire l'oggetto della e-mail
  .Subject = "Invio email con CDO"
‘Inserire il corpo della email in testo semplice
  .TextBody = "Inserire il corpo del messaggio." & vbCRLF & "Si consiglia di creare una variabile per contenere tutto il testo"
‘Spedizione della mail
  .Send
End With

    Set cdoMess = Nothing
End Sub

Il codice sopra riportato è ampiamente commentato e non serve aggiungere ulteriori spiegazioni, possiamo però perfezionare il codice aggiungendo altri parametri. Per esempio, supponiamo di avere i dati di spedizione della mail in un foglio di lavoro denominato “Setup” e di doverli recuperare in automatico.

Fig. 1

In questi casi sarebbe opportuno dividere la procedura in 2 routine, in cui una si occupa di recuperare i dati presenti nel foglio di lavoro e passarli alla seconda che li processerà e invierà l’email. Per recuperare i dati dal foglio “Setup” possiamo usare un codice come il seguente:

 Sub Prova()
 Dim Eto As String, Efrom As String, Eogg As String, Emess As String, Esmtp As String, Epass As String 
        Eto = Sheets("setup").Range("B2")
        Efrom = Sheets("setup").Range("B1")
        Eogg = Sheets("setup").Range("B3")
        Emess = Sheets("setup").Range("B4")
        Esmtp = Sheets("setup").Range("B5")
        Epass = Sheets("setup").Range("B6")
    inviaE Eto, Efrom, Eogg, Emess, Esmtp, Epass
End Sub

Mentre la routine che invierà la mail presenterà questo codice

Sub inviaE(Eto As String, Efrom As String, Eogg As String, Emess As String, Esmtp As String, Epass As String)
'istanza dell'oggetto CDO
Set cdoMess = CreateObject("CDO.message")

With cdoMess.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Esmtp
.Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 587
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Efrom
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Epass
.Update
End With

With cdoMess
.To = Eto
.From = Efrom
.Subject = Eogg
.TextBody = Emess
.Send
End With

Set cdoMess = Nothing
End Sub

Possiamo anche allegare uno o più file al messaggio modificando il ciclo With in questo modo:

With cdoMess
.To = Eto
.From = Efrom
.Subject = Eogg
.TextBody = Emess
.AddAttachment "C:\Test\info.txt"
.Send
End With

Oppure inserire il percorso nel foglio “Setup” e allegarlo sotto forma di variabile come visto in precedenza.
A volte può presentarsi la necessità di dover spedire delle email con un testo standard, può essere una promozione di certi prodotti, oppure un avviso qualsiasi, in questi casi è possibile inserire il testo presente in un file nel corpo della mail in questo modo:

  'Queste costanti sono definite per rendere il codice più leggibile
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
'Aprire il file in lettura
Set f = fso.OpenTextFile("C:\Test\annuncio.txt", ForReading)
'Il metodo ReadAll legge l'intero file nella variabile BodyText
BodyText = f.ReadAll
'Chiudi il file
f.Close
Set f = Nothing
Set fso = Nothing

With cdoMess
.To = Eto
.From = Efrom
.Subject = Eogg
.TextBody = BodyText
.Send
End With

Set cdoMess = Nothing
End Sub

Il codice sopra riportato mostra come leggere il contenuto di un file (annuncio.txt) e inserirlo in una variabile (BodyText) che costituirà il corpo del messaggio. La routine completa in questo caso diventa:

 Sub inviaE(Eto As String, Efrom As String, Eogg As String, Emess As String, Esmtp As String, Epass As String)
'istanza dell'oggetto CDO
Set cdoMess = CreateObject("CDO.message")

With cdoMess.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Esmtp
.Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 587
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Efrom
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Epass
.Update
End With

'Queste costanti sono definite per rendere il codice più leggibile
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
'Aprire il file in lettura
Set f = fso.OpenTextFile("C:\Test\annuncio.txt", ForReading)
'Il metodo ReadAll legge l'intero file nella variabile BodyText
BodyText = f.ReadAll
'Chiudi il file
f.Close
Set f = Nothing
Set fso = Nothing

With cdoMess
.To = Eto
.From = Efrom
.Subject = Eogg
.TextBody = BodyText
.Send
End With

Set cdoMess = Nothing
End Sub

Sub Prova()
    Dim Eto As String, Efrom As String, Eogg As String, Emess As String, Esmtp As String, Epass As String

        Eto = Sheets("setup").Range("B2")
        Efrom = Sheets("setup").Range("B1")
        Eogg = Sheets("setup").Range("B3")
        Emess = Sheets("setup").Range("B4")
        Esmtp = Sheets("setup").Range("B5")
        Epass = Sheets("setup").Range("B6")
     
    inviaE Eto, Efrom, Eogg, Emess, Esmtp, Epass

End Sub

A questo punto si dovrebbe aggiungere al codice una corretta gestione degli errori per evitare e prevenire errori quando la routine è in esecuzione. Possiamo modificare il listato come di seguito riportato

Sub inviaE(Eto As String, Efrom As String, Eogg As String, Emess As String, Esmtp As String, Epass As String)
'istanza dell'oggetto CDO
Set cdoMess = CreateObject("CDO.message")
'Gestione errori
On Error GoTo err

With cdoMess.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Esmtp
.Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 587
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Efrom
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Epass
.Update
End With

'Queste costanti sono definite per rendere il codice più leggibile
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
[COLOR="green"]'Aprire il file in lettura
Set f = fso.OpenTextFile("C:\Test\annuncio.txt", ForReading)
'Il metodo ReadAll legge l'intero file nella variabile BodyText
BodyText = f.ReadAll
'Chiudi il file
f.Close
Set f = Nothing
Set fso = Nothing

With cdoMess
.To = Eto
.From = Efrom
.Subject = Eogg
.TextBody = BodyText
.Send
End With

Set cdoMess = Nothing

err:
 If err.Number = 53 Then
        MsgBox "Manca il file da allegare. Procedura terminata"
        Exit Sub
    End If
End Sub
Sub Prova()

    Dim Eto As String, Efrom As String, Eogg As String, Emess As String, Esmtp As String, Epass As String
    
   'controllo se esiste il destinatario
    If Trim(Sheets("setup").Range("B2")) = "" Then
        MsgBox "Manca Il Destinatario"
        Exit Sub
         Else
           Eto = Sheets("setup").Range("B2")
    End If

           'controllo se esiste il mittente
          If Trim(Sheets("setup").Range("B1")) = "" Then
            MsgBox "Manca Il Mittente"
            Exit Sub
              Else
               Efrom = Sheets("setup").Range("B1")
           End If
    
         'controllo è stato inserito l'oggetto della mail
          If Trim(Sheets("setup").Range("B3")) = "" Then
            MsgBox "Manca L'Oggetto della Mail"
            Exit Sub
              Else
               Eogg = Sheets("setup").Range("B3")
           End If
        
    Emess = Sheets("setup").Range("B4")
    
            'controllo se ci sono i dati dell'smtp
          If Trim(Sheets("setup").Range("B5")) = "" Then
            MsgBox "Manca SMTP da usare"
            Exit Sub
              Else
               Esmtp = Sheets("setup").Range("B5")
           End If
    
           'controllo se c'è la password per l'smtp
          If Trim(Sheets("setup").Range("B6")) = "" Then
            MsgBox "Manca la password dell'SMTP da usare"
            Exit Sub
              Else
               Epass = Sheets("setup").Range("B6")
           End If
     
    inviaE Eto, Efrom, Eogg, Emess, Esmtp, Epass

End Sub

[Alexsandra]

Metodi e Proprietà per gestire le righe del foglio di lavoro

La Proprietà Range.End
In VBA sarà spesso necessario fare riferimento a una cella alla fine di un blocco, ad esempio, per determinare l'ultima riga utilizzata in un intervallo. La struttura finale è utilizzata con riferimento a un oggetto Range e restituisce la cella che si trova alla fine della regione in cui il range di riferimento è contenuto in una determinata direzione, ed è simile a premere CTRL + freccia SU’, CTRL + freccia GIÙ, CTRL + freccia Sinistra o CTRL + freccia Destra. La sintassi è la seguente: RangeObject. End (Direction). È necessario specificare l'argomento Direction, che indica la direzione di movimento, per esempio .End (xlDown) indica lo spostamento verso il basso, mentre .End (xlToRight) indica lo spostamento verso destra.


Utilizzare End (xlUp) per determinare l’ultima riga con i dati in una colonna
End (xlUp) è uno dei metodi più comunemente utilizzati per determinare l'ultima riga utilizzata, contenente dei dati.Rows.Count restituisce l'ultima riga del foglio di lavoro, se consideriamo che Excel 2007 dispone di 1.048.576 righe, l’istruzione .Cells (Rows.Count, "B") restituisce la cella B1048576, vale a dire l’ultima cella della colonna B, e il codice parte da questa cella e scorre tutta la colonna verso l'alto fino a trovare una cella che contiene dei dati

Sub ultima_1()
Dim ultimaR As Long
ultimaR = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
MsgBox ultimaR
End Sub
 
Sub ultima_2()
Dim ultimaR As Long
ultimaR = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
MsgBox ultimaR
End Sub

Utilizzare End (xlToLeft) per determinare l’ultima colonna con i dati
Restituisce il numero dell’ultima colonna con i dati in una riga specificata, nel caso di una riga vuota restituirà il valore 1. Non vengono considerate le celle formattate, ma senza dati, mentre si considerano costanti e formule. Se l'ultima colonna con i dati è nascosta, questa colonna viene ignorata

Sub ultima_3()
Dim ultimaC As Integer
ultimaC = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column
MsgBox ultimaC
End Sub

La proprietà UsedRange per trovare l'ultima riga
Per restituire l'intervallo utilizzato in un foglio di lavoro, si utilizza la proprietà Worksheet.UsedRange che presenta la seguente sintassi: WorksheetObject.UsedRange e include anche le celle formattate con dati o celle con dati il cui contenuto è stato eliminato, e in questo caso potrebbe includere apparentemente celle vuote visibili. Ad esempio, se si applica il formato data a una cella, in questo caso, cancellare il contenuto e la formattazione potrebbe non essere sufficiente per re-impostare la riga o cella e in questo caso si dovrà eliminare la riga.

Sub ultima_4()
Dim ultimaR As Long
ultimaR = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
MsgBox ultimaR
End Sub
 
Sub ultima_5()
Dim ultimaR As Long
ultimaR = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
MsgBox ultimaR
End Sub

La Proprietà UsedRange per trovare l'ultima colonna

Sub ultima_6()
Dim ultimaC As Integer
ultimaC = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count
MsgBox ultimaC
End Sub
 
Sub ultima_7()
Dim ultimaC As Integer
ultimaC = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
MsgBox ultimaC
End Sub

La Proprietà UsedRange per contare il numero di righe utilizzate

Sub prova_RU()
Dim rigaU As Long
rigaU = ActiveSheet.UsedRange.Rows.Count
MsgBox rigaU
End Sub

La Proprietà UsedRange per contare il numero di colonne utilizzate

Sub prova_CU()
Dim colonnaU As Integer
colonnaU = ActiveSheet.UsedRange.Columns.Count
MsgBox colonnaU
End Sub

La proprietà UsedRange per trovare la prima riga utilizzata

Sub prima_RU1()
Dim primaR As Long
primaR = ActiveSheet.UsedRange.Cells(1).Row
MsgBox primaR
End Sub
 
Sub prima_RU2()
Dim primaR As Long
primaR = ActiveSheet.UsedRange.Row
MsgBox primaR
End Sub

La Proprietà UsedRange per trovare la prima colonna utilizzata

Sub prima_CU1()
Dim primaC As Integer
primaC = ActiveSheet.UsedRange.Cells(1).Column
MsgBox primaC
End Sub
 
Sub prima_CU2()
Dim primaC As Integer
primaC = ActiveSheet.UsedRange.Column
MsgBox primaC
End Sub

La Proprietà Row e Column
Per restituire il numero della prima riga in un intervallo, si utilizza la proprietà Range.Row e se l'intervallo specificato contiene più aree, questa proprietà restituirà il numero della prima riga della prima area. La sintassi utilizzata è la seguente: RangeObject.Row, mentre invece per restituire il numero della prima colonna in un intervallo, si utilizza la proprietà Range.Column e se l'intervallo specificato contiene più aree, questa proprietà restituirà il numero della prima colonna nella prima area. La sintassi è: RangeObject.Column

Esempi della proprietà Row
Applicare il colore giallo a tutte le righe dell’intervallo B2:D4
Worksheets ("Foglio1"). Range ("B2: D4"). Rows.Interior.Color = vbYellow

Applicare il colore verde alla prima riga del range B2:D2
Worksheets ("Foglio1"). Range ("B2: D4"). Row (1) Interior.Color = vbGreen

Se l'oggetto specificato contiene più zone, le righe della prima area verranno restituite solo da questa proprietà.
Prendiamo l'esempio di 2 aree nell'intervallo specificato, la prima area sarà "B2: D4" e la seconda sarà "F3: G6", il seguente codice applica il colore rosso alle celle alla prima riga della prima area (B2:D4)

Worksheets ("Foglio1") .Range ("B2: D4, F3: G6"). Row (1) Interior.Color = vbRed

Esempi della proprietà Columns
Applicare il colore giallo a tutte le colonne dell’intervallo specificato, cioè B2:D4
Worksheets ("Foglio1"). Range ("B2: D4"). Columns.Interior.Color = vbYellow

Applicare il colore verde alla prima colonna del range B2:B4
Worksheets ("Foglio1"). Range ("B2: D4"). Columns (1) Interior.Color = vbGreen

Se l'oggetto specificato contiene più zone, le colonne della prima area verranno restituite solo da questa proprietà. Per esempio se abbiamo 2 aree nell'intervallo specificato, e la prima area sarà "B2: D4" mentre la seconda area sarà "F3: G6", il seguente codice applica il colore rosso alle celle dalla prima colonna della prima area alle celle da B2 a B4

Worksheets ("Foglio1"). Range ("B2: D4, F3: G6"). Columns (1) Interior.Color = vbRed


Utilizzare la proprietà End (xlDown) per determinare l’ultima riga

Sub ultimaR1()
Dim ultimaR As Long
ultimaR = ActiveSheet.Range("D2").End(xlDown).Row
MsgBox ultimaR
End Sub

Utilizzare End (xlToRight) per determinare l’ultima colonna

Sub ultima8()
Dim ultimaC As Integer
ultimaC = ActiveSheet.Range("C4").End(xlToRight).Column
MsgBox ultimaC
End Sub

Esempi di utilizzo della proprietà Range.End: Selezione di una particolare riga o colonna come da Figura 1

Fig. 1

Sub prova1()
Dim ws As Worksheet
Set ws = Worksheets("Foglio1")
ws.activate
 
'seleziona la cella C12 (Elena)
Range("C5").End(xlDown).Select
'seleziona la cella C17 (55), la cella C12 è l'ultima cella di dati in un blocco
‘in questo caso si seleziona la cella successiva con dati che è C17
Range("C12").End(xlDown).Select
'seleziona la cella C18 (66)
Range("C17").End(xlDown).Select
'seleziona la cella C17 (55), la cella C14 è una cella vuota
‘e in questo caso seleziona la cella successiva con i dati
Range("C14").End(xlDown).Select
'seleziona l'ultima riga del foglio di lavoro se la colonna è vuota
‘che è la cella F1048576 in quanto Excel 2007 ha 1.048.576 righe
Range("F1").End(xlDown).Select
'seleziona la cella E7 (7)
Range("C7").End(xlToRight).Select
'seleziona la cella G7 (22)
Range("E7").End(xlToRight).Select
'seleziona cella XFD7, che è l'ultima colonna della riga 7, in quanto 
‘la cella I7 è l'ultima cella con i dati in questa riga
Range("I7").End(xlToRight).Select
'seleziona la cella I7 (26)
Range("I14").End(xlUp).Select
'seleziona la cella E6 (Luca)
Range("E18").End(xlUp).Select
'seleziona il range C5:C12
Range("C5", Range("C5").End(xlDown)).Select
End Sub

Il metodo Find per determinare l'ultima riga
Restituisce l’ultima riga con i dati in un foglio di lavoro. In caso di un foglio di lavoro vuoto darà un errore di run-time.
Per cercare un articolo specifico o un valore in un intervallo, si utilizza il metodo Find che restituisce il Range, vale a dire, la prima cella, dove si trova l'elemento o valore. Se non viene trovata alcuna corrispondenza, restituisce Nothing.

L’istruzione SearchDirection
È possibile specificare l’argomento xlNext per indicare di eseguire ricerche verso il basso (cioè al valore corrispondente successivo) o xlPrevious per ricerche verso l'alto o all'indietro (cioè al valore corrispondente precedente) nel campo di ricerca. Il valore predefinito è xlNext. Se si specifica After: = Range ("A13"), in cui il campo di ricerca è il Range ("A1: A20") e si imposta la direzione di ricerca in SearchDirection: = xlNext, allora la funzione di ricerca inizierà a cercare dalla cella A14 fino alla A20 per poi ricercare dal Range ("A1") fino al Range ("A13”)

Sub prova2()
Dim ultimaC As Long, rng As Range
Set rng = ActiveSheet.Cells
ultimaC = rng.Find(What:="*", After:=rng.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
MsgBox ultimaC
End Sub

Il metodo Find per determinare l’ultima colonna

Sub prova3()
Dim ultimaC As Integer, rng As Range
Set rng = ActiveSheet.Cells

ultimaC = rng.Find(What:="*", After:=rng.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
 
MsgBox ultimaC
End Sub

Il metodo SpecialCells per trovare l’ultima riga

Sub prova4()
Dim ultimaR As Long
ultimaR = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
MsgBox ultimaR
End Sub
  
Sub prova5()
Dim ultimaR As Long
ultimaR = ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Row
MsgBox ultimaR
End Sub

Il Metodo Range.SpecialCells
Si utilizza il metodo Range.SpecialCells con la sintassi: RangeObject.SpecialCells (Type, Value), dove l'argomento type specifica il tipo di cella come costanti XlCellType, da restituire ed è obbligatorio specificare questo argomento, mentre invece l’argomento Value è facoltativo e specifica i valori come per le costanti XlSpecialCellsValue, nel caso di xlCellTypeConstants o xlCellTypeFormulas viene specificato nell'argomento Type. Non specificando l'argomento Value per impostazione predefinita vengono inclusi tutti i valori delle costanti o formule, nel caso di xlCellTypeConstants o xlCellTypeFormulas rispettivamente. Usando questo metodo viene restituito un oggetto Range, composto da celle corrispondenti agli argomenti type e value specificati

I vari tipi di Costanti XlCellType

• xlCellTypeAllFormatConditions: Si riferisce a tutte le celle con formattazione condizionale (valore -4172)
• xlCellTypeAllValidation: Fa riferimento alle celle che contengono una convalida (valore -4.174)
• xlCellTypeBlanks: Si riferisce a celle vuote (valore 4)
• xlCellTypeComments: Fa riferimento alle celle con commenti (valore di -4144)
• xlCellTypeConstants: Fa riferimento alle celle che contengono costanti (valore 2)
• xlCellTypeFormulas: Fa riferimento alle celle che contengono formule (valore -4.123)
• xlCellTypeLastCell: Si riferisce all'ultima cella nell'intervallo utilizzato (valore 11)
• xlCellTypeSameFormatConditions: Si riferisce a celle con lo stesso formato (valore -4173)
• xlCellTypeSameValidation: Si riferisce a celle con la stessa convalida (valore -4175)
• xlCellTypeVisible: Si riferisce a tutte le celle che sono visibili (valore 12)

Il Metodo SpecialCells per trovare l’ultima colonna

Sub prova6()
Dim ultimaC As Integer
ultimaC = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
MsgBox ultimaC
End Sub

Sub prova7()
Dim ultimaC As Integer
ultimaC = ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Column
MsgBox ultimaC
End Sub

[Alexsandra]

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)

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

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

[Alexsandra]

Utilizzare il controllo ListView

Il controllo ListView viene utilizzato per visualizzare informazioni di tipo gerarchico e consente di mostrare elenchi o liste di dati, oltre ad essere di grande impatto visivo. Questo tipo di controllo è diventato popolare con Windows Explorer in quanto è lo stesso tipo di lista usata dall'interfaccia di Explorer (Gestione risorse o Esplora risorse) per visualizzare Files e cartelle, inoltre le sue proprietà permettono di personalizzarne la visualizzazione in quattro stili diversi che sono:

• LargeIcon (Icone grandi): Ogni elemento è visualizzato con un’icona e del testo in basso
• SmallIcon (Icone piccole): Ogni elemento è visualizzato con una piccola icona e del testo alla sua destra.
• Details (Dettagli): Gli elementi sono disposti uno per riga. Ogni riga è suddivisa in più colonne, la prima contiene l'elemento stesso, le altre visualizzano i suoi attributi, inoltre ogni colonna ha un'intestazione.
• List (Elenco): Ogni elemento è visualizzato con una piccola icona e del testo alla sua destra e gli elementi sono organizzati in colonne senza intestazione.

Per rendersi conto di come viene visualizzata ciascuna modalità basta aprire Windows Explorer e selezionare i comandi corrispondenti nel menu Visualizza e per darvi un’idea della flessibilità di questo controllo dovete sapere che il desktop di Windows non è nient’altro che un grande controllo ListView in modalità Icon, con sfondo trasparente.
Il controllo ListView è un componente aggiuntivo .ocx che può essere aggiunto a Visual Basic attraverso Windows Common Control 6.0 e per averlo disponibile in VB per Excel si deve seguire il percorso dal menu Strumenti – Controlli aggiuntivi e nella finestra che appare scorrere la lista e selezionare la voce Microsoft Listview Control, versione 6.0.

Fig. 1

Una volta confermata la scelta premendo sul pulsante Ok nella casella degli strumenti apparirà l’icona del controllo ListView

Fig. 2

Il controllo ListView dispone di due collection distinte:

• ListItems che comprende gli elementi testuali e grafici che rappresentano le voci da visualizzare e in modalità Report, è possibile specificare, per ogni voce, tutte le rispettive sottovoci mediante l’array ListSubItems.
• ColumnHeaders che include oggetti che influenzano l’aspetto delle singole intestazioni delle colonne visibili in modalità Report.

Esaminiamo ora la proprietà ListView che può essere: Icon View, Small Icon View, List View e Report View e per impostare una modalità di visualizzazione si deve assegnare alla proprietà View uno dei seguenti valori costanti:

0-lvwIcon = Icon View
1-lvwSmallIcon = Small Icon View
2-lvwList = List View
3-lvwReport = Report View

Per aggiungere un elemento al controllo ListView si deve usare il metodo Add() della collezione ListItems, tenendo presente che ogni riga di un oggetto ListView può essere definito in due parti

ListView1.ListItems(x): Specifica la riga per la prima colonna della riga
ListView1.ListItems(x).ListSubItems(y): Consente di specificare le colonne adiacenti, per esempio: ListView1.ListItems(5).ListSubItems(1) indica la seconda colonna della quinta riga della ListView

Per cui la sintassi per aggiungere una riga è la seguente: ListView1.ListItems.Add [Index], [Key], [Text], [Icon], [SmallIcon] , in cui le voci rappresentano:

[Index]: Valore Opzionale
È un numero che indica la posizione della voce all’interno della collezione. Se viene omesso, la voce viene inserita in coda alla collezione. Il suo valore varia in funzione di successivi inserimenti e cancellazioni
[Key]: Valore Opzionale
E’ una stringa che rappresenta la chiave identificativa univoca di ogni voce nella collezione. Utile per la ricerca di una voce.
[Text]: Valore Opzionale
Rappresenta il testo che viene mostrato nel controllo, eventualmente associata ad una icona.
[Icon]: Valore Opzionale
Specifica l'immagine da visualizzare quando il ListView è la modalità lvwIcon
[SmallIcon]: Valore Opzionale
Specifica l'immagine da visualizzare quando ListView è lvwSmallIcon, lvwList o in modalità lvwReport

Mentre invece la sintassi per aggiungere un elemento alla colonna di destra della riga specificata è la seguente: ListView1.ListItems(1).ListSubItems.Add [Index], [Key], [Text], [ReportIcon], [TooltipText] , dove:

1:
Specifica il numero della riga nel controllo ListView.
[Index]: Valore Opzionale
Specifica il numero di colonna per l'aggiunta di un dato. Il valore 1 corrisponde alla seconda colonna di un oggetto ListView
[Key]: Valore Opzionale
E’ una stringa che rappresenta la chiave identificativa univoca di ogni voce nella collezione
[Text]: Valore Opzionale
Specifica il testo che verrà visualizzato nel ListView
[ReportIcon]: Valore Opzionale
Visualizza un'icona o un’immagine in base all'elemento specificato
[TooltipText]: Valore Opzionale
Aggiunge un tooltip nell'elemento specificato

Mentre invece per aggiungere delle colonne, è necessario prima definire i testi, le dimensioni e le intestazioni usando la seguente sintassi: ListView1.ColumnHeaders.Add [Index], [Key], [Text], [Width], [Alignment], [Icon], dove le voci rappresentano:

[Index]: Valore Opzionale
[Key] Valore Opzionale .
E’ una stringa che rappresenta la chiave identificativa univoca di ogni voce nella collezione
[Text]: Valore Opzionale .
Specifica il testo che verrà visualizzato nel ListView.
[Width]: Valore Opzionale .
Specifica la larghezza della colonna. Il valore predefinito è 72 punti
[Alignment]: Valore Opzionale .
Specifica l'allineamento della colonna. Le costanti disponibili:. LvwColumnLeft (Default) lvwColumnCenter, lvwColumnRight
[Icon]: Valore Opzionale .
Specifica l'immagine da visualizzare nell'intestazione.

L’esempio che segue mostra il principio di riempimento di un oggetto ListView.

Private Sub UserForm_Initialize()
    With ListView1
        'Imposta il numero di colonne e intestazioni
        With .ColumnHeaders
            'Rimuove le vecchie intestazioni
            .Clear
           'aggiunge 3 colonne specificando il nome dell'intestazione
            'e la larghezza della colonna
            .Add , , "Nome", 80
            .Add , , "Città", 50
            .Add , , "Età", 50
        End With
       'Riempie la prima colonna con 3 righe
        With .ListItems
           .Add , , "Gino"
           .Add , , "Mario"
           .Add , , "Elisa"
         End With
      'Riempie le colonne 2 e 3 della prima riga
        .ListItems(1).ListSubItems.Add , , "Città1"
        .ListItems(1).ListSubItems.Add , , 30
       'Riempie le colonne 2 e 3 della seconda riga
        .ListItems(2).ListSubItems.Add , , "Città2"
        .ListItems(2).ListSubItems.Add , , 27
        'Riempie le colonne 2 e 3 della terza riga
        .ListItems(3).ListSubItems.Add , , "Città3"
        .ListItems(3).ListSubItems.Add , , 41
    End With
  'Specifica le modalità di visualizzazione in "Dettagli"
    ListView1.View = lvwReport
End Sub

E si ottiene una Form come la seguente

Fig. 3

Questa macro è un esempio semplificato ed è ovviamente possibile creare un loop per ottimizzare il riempimento. Una volta visualizzati nel controllo, i dati possono essere letti e modificati, la procedura sotto riportata scorre tutto il ListView e trasferisce le informazioni in un foglio di calcolo.

Private Sub CommandButton1_Click()
    Dim i As Integer, j As Integer
   'ciclo su tutte le righe
    For i = 1 To ListView1.ListItems.Count
        Cells(i, 1) = ListView1.ListItems(i).Text
       'Loop sulle colonne
        For j = 1 To ListView1.ColumnHeaders.Count - 1
            Cells(i, j + 1) = ListView1.ListItems(i).ListSubItems(j).Text
        Next j
    Next i
End Sub

Fig. 4

Le informazioni contenute in una ListView possono essere facilmente modificate, ad esempio, se vogliamo modificare il testo nella terza colonna della prima riga possiamo usare un codice come il seguente

ListView1.listItems(1).listSubItems(2).Text = "Prova"

Un altro esempio per cambiare il testo nella terza riga della prima colonna

ListView1.ListItems(3).Text = "prova Modifica"

I dati nella prima colonna possono essere modificati anche manualmente nel controllo ListView, ma è possibile impedire questa azione specificando il valore 1 (lvwManual) nella proprietà LabelEdit. Oppure tramite questo codice

ListView1.labeledit = 1

E’ inoltre possibile assegnare elementi chiave unici in una ListView in modo che i dati possono essere recuperati tramite questa chiave di identificazione. Per esempio può essere recuperato il contenuto della voce a cui viene assegnato il tasto "A1". Nota: la procedura restituisce un errore se la chiave non esiste nel ListView.

MsgBox ListView1.ListItems("A1").Text

E per recuperare una specifica voce sotto "A2" nell'elemento "A1"

MsgBox ListView1.ListItems("A1").ListSubItems("A2").Text

È inoltre possibile ottenere la chiave di una riga, questa procedura restituisce una stringa vuota se non è stato assegnato nessun tasto.

MsgBox ListView1.ListItems(2).Key

Questa macro consente di assegnare una chiave per la ListItem della seconda riga e se la chiave esiste già per questo elemento, verrà sovrascritto. Se si tenta di assegnare una chiave già assegnata ad un altro elemento, la procedura restituisce un messaggio di errore, e questo è logico in quanto la chiave deve essere univoca.

Private Sub CommandButton2_Click()
   'Legge la chiave originale
    MsgBox ListView1.ListItems(2).Key
   'Assegnare una nuova chiave al ListItem della seconda riga
    ListView1.ListItems(2).Key = "Nuova Key"
    'verifica  delle  nuove  chiavi 
    MsgBox ListView1.ListItems(2).Key
End Sub

Inoltre è possibile eliminare delle righe specifiche nella ListView.

  'Rimuovere la terza riga
ListView1.ListItems.Remove 3
'altro esempio per eliminare una riga in base alla sua Key 
ListView1.ListItems.Remove "A1"
'Eliminare la riga attiva
ListView1. ListItems. Remove (ListView1. SelectedItem. Index)

Mentre invece per eliminare tutti i dati in un controllo ListView si usa questo codice:

ListView1.ListItems.Clear

E possibile modificare la formattazione del testo del controllo per personalizzare la visualizzazione delle informazioni, nel codice sotto riportato si modifica il colore del testo nel 2 ° elemento della prima riga.

ListView1.listitems(1).ListSubItems(2).ForeColor = RGB(100, 0, 100)

Oppure si può applicare un formato a una "cella” del listview

ListView1.ListItems(2).ListSubItems.Add , , Format(1234567.89, "##,##0.00")

Inoltre tramite la proprietà FullRowSelect si può evidenziare l'intera riga in una selezione.

ListView1.FullRowSelect = True

La proprietà Griglia permette di visualizzare una griglia nel ListView, questa proprietà è molto utile per migliorare la leggibilità dei dati

ListView1.Gridlines = True

Un’altra opzione del controllo consente di visualizzare le caselle di controllo nella colonna di sinistra.

Me.ListView1.CheckBoxes = True

È quindi possibile specificare lo stato di default del CheckBox, se non si specifica questo parametro, il testo non sarà visibile subito, ma è necessario fare clic sul bordo sinistro della riga per far apparire il CheckBox.

Dim i As Integer
For i = 1 To ListView1.ListItems.Count
    ListView1.ListItems(i).Checked = False
Next i

Possiamo usare l'evento ItemCheck per identificare quando una casella è selezionata oppure deselezionata e modificare il colore del testo in blu e grassetto.

Private Sub ListView1_ItemCheck(ByVal Item As MSComctlLib.ListItem)
    Dim j As Integer
    If Item.Checked = True Then
            'Cambia Colore
            Item.ForeColor = RGB(0, 0, 255) 
            'Imposta il grassetto
            Item.Bold = True 
            
            For j = 1 To Item.ListSubItems.Count
                Item.ListSubItems(j).ForeColor = RGB(0, 0, 255)
                Item.ListSubItems(j).Bold = True
            Next j
        Else
             'Cambia Colore
            Item.ForeColor = RGB(1, 0, 0) 
            Item.Bold = False
            
            For j = 1 To Item.ListSubItems.Count
                Item.ListSubItems(j).ForeColor = RGB(1, 0, 0)
                Item.ListSubItems(j).Bold = False
            Next j
    End If
End Sub

Inoltre è possibile scegliere di nascondere le intestazioni delle colonne utilizzando la proprietà HideColumnHeaders.

ListView1.HideColumnHeaders = True

La seguente macro specifica che i dati devono essere centrati nella colonna

ListView1.ColumnHeaders.Add , , "Città", 50, lvwColumnCenter

La struttura permette tramite la proprietà AllowColumnReorder di spostare la posizione delle colonne tramite un drag & drop.

ListView1.AllowColumnReorder = True

[Alexsandra]

Gestire gli input da tastiera in un controllo TextBox

Durante la stesura di programmi o verticalizzazioni in VBA si verifica molto spesso la necessità di fare in modo che un utente in una TextBox possa digitare solo un input specifico, come numeri interi, stringhe etc. sia per evitare errori di elaborazione del dato inserito che per una corretta scrittura di dati specifici nei relativi fogli di lavoro. E’ possibile eseguire il controllo sul testo immesso anche successivamente all’immissione, ma risulta molto più comodo limitare la scelta del tipo di dati da inserire (numeri, stringhe etc.) direttamente nella TextBox utilizzando l’evento "KeyPress", che contiene il tasto digitato, e il suo codice Ascii per controllarlo. Prima di iniziare ad usare codice VBA per programmare il TextBox è consigliato stilare una lista delle opzioni e dei vincoli che la casella di testo (TextBox) deve avere, inoltre si deve aggiungere anche il nostro obiettivo finale, che è quello di scrivere il valore desiderato in una cella, in formato numerico, nel foglio di lavoro, pertanto la lista potrebbe essere come la seguente:

1. Accettare solo numeri, una virgola o un segno – (meno)
2. Accettare solo un segno meno, che si deve trovare all'inizio della stringa
3. Accettare solo un punto posizionato nella posizione desiderata.
4. Scrivere il valore del TextBox in un formato numerico nel foglio di lavoro

Infine, ci si deve porre una domanda significativa; il nostro codice viene usato una sola volta oppure poco frequentemente o viene richiamato ripetutamente? Se è così, possiamo costruire una funzione e richiamarla ogni volta che ne abbiamo bisogno.

Iniziamo con la costruzione di una UserFom denominata "Form1", in cui riponiamo una TextBox denominata "Text1" e un pulsante di comando denominato "Command1" che cliccando su di esso convaliderà l'assegnazione del valore della nostra TextBox nell'apposita cella del foglio di lavoro. Iniziamo con la verifica del testo inserito nella TextBox che sia di formato numerico e che possa contenere una virgola o un segno meno utilizzando il seguente codice

Private Sub Text1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If InStr("1234567890,-", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End sub

Analizziamo questa riga: If InStr("1234567890,-", Chr(KeyAscii)) = 0 Then KeyAscii = 0

1. La funzione Chr restituisce una stringa contenente il carattere associato al codice carattere specificato nella variabile KeyAscii che corrisponde al codice del tasto premuto nella nostra procedura.
2. La funzione InStr (stringa1, stringa2), restituisce un valore di tipo Variant, che indica la posizione della prima occorrenza di una stringa (stringa2) all'interno di un'altra stringa (stringa1), nel nostro codice abbiamo: stringa1 = "1234567890, -" e stringa2 = Chr (KeyAscii)).
3. La funzione = 0 rappresenta un avviso che non è stata trovata l’occorrenza nella stringa di riferimento e quindi restituisce 0.
4. L’enunciato KeyAscii = 0 è un valore nullo assegnato al pulsante premuto che equivale ad annullare il testo digitato.

Molto brevemente con il codice sopra esposto verifichiamo se non c'è un’occorrenza del carattere corrispondente al tasto premuto nella nostra stringa di riferimento, in tal caso non prendiamo in considerazione il testo digitato. Testando il codice nella UserForm otteniamo l'effetto desiderato, ma l'utente potrebbe avere la sensazione che la sua tastiera possa avere un problema (non scrive i caratteri), si dovrebbe rimandare un messaggio di errore, ma pesante a quanti avvisi potrebbe ricevere l’utente utilizzando un metodo come questo. Risulta più conveniente mettere un "Beep" tramite l’altoparlante di sistema per comunicare all’utente che il testo digitato non è permesso, pertanto il codice diventa:

Private Sub Text1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If InStr("1234567890,-", Chr(KeyAscii)) = 0 Then KeyAscii = 0 : Beep
End sub

A questo punto è possibile modificare il codice per accettare un segno – (meno) che sarà posto all'inizio della stringa con l’aggiunta di un operatore (Or) nella seguente forma:

Private Sub Text1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If InStr("1234567890,-", Chr(KeyAscii)) = 0 Or Text1.SelStart > 0 And Chr(KeyAscii) = "-"  _ 
Then KeyAscii = 0 : Beep
End If

Analizziamo questa parte: Or Text1.SelStart> 0 And Chr (KeyAscii) = '' - ''

1. La proprietà SelStart indica l'inizio del testo selezionato, o il punto di inserimento e se non viene selezionato nessun testo, l'intervallo di valori validi è compreso tra 0 e il numero totale di caratteri nell'area di modifica del controllo e pertanto restituisce la posizione che è occupata dal carattere premuto, se questa non corrisponde al primo (0), l'inserimento viene cancellato
2. And Chr (KeyAscii) = "-" assicura che SelStart venga applicata solo a un carattere.

A questo punto, è possibile consentire di poter digitare una virgola in qualsiasi punto tra due numeri, ma una sola volta. Fondamentalmente abbiamo bisogno di un nuovo operatore (And) nella seguente forma:

Private Sub Text1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If InStr("1234567890,-", Chr(KeyAscii)) = 0 Or Text1.SelStart > 0 And Chr(KeyAscii) = "-" _
Or InStr(Text1.Value, ",") <> 0 And Chr(KeyAscii) = ","  Then KeyAscii = 0 : Beep
End If

Analizziamo questa parte: Or InStr (Text1.Value, ",") <> 0 And Chr (KeyAscii) = ","

1. Viene utilizzato, nuovamente, per verificare se InStr ha già un punto esistente nella stringa.
2. Se il carattere è un punto (che sarebbe troppo), viene rifiutato.

In sostanza, se c'è già un punto nella stringa, e se il carattere digitato è un punto, vale a dire che stiamo cercando di inserire un secondo punto, viene rifiutato. A questo punto si dovrebbe cercare di vietare il copia e incolla, compreso il controllo della clipboard, ma questo aspetto è più difficile in quanto non possiamo semplicemente prendere in considerazione solo il primo livello degli Appunti di Excel, ma dobbiamo anche considerare Windows, e questo è oltre la portata di questo tutorial, pertanto per il momento riteniamo che non c'è nessun evento copia/Incolla diretto al TextBox, quindi proseguiamo con l’analisi degli altri vincoli da rispettare che sono i seguenti:

1. Verificare che la stringa non è vuota.
2. Che non ha punti.
3. Se ha un solo carattere, e che non è parte di una delle 10 cifre, viene rifiutato.
4. Che si tratta di una stringa che rappresenta un numero come definito inizialmente.

Quindi useremo l’evento Private Sub Text1_BeforeUpdate (ByVal Cancel As MSForms.ReturnBoolean), che si verifica prima di modificare i dati in un controllo, per controllare il valore della casella di testo prima che venga convalidato. Poco sopra abbiamo detto che se il codice venisse utilizzato di frequente sarebbe indicato utilizzare, o meglio, creare una funzione personale sia per fornire ergonomia professionale alla futura applicazione, che per comodità. Quindi possiamo sfruttare l'opportunità per costruire una funzione a questo livello con il seguente codice:

Private Sub Text1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim stringa1 As String
Stringa1 = Text1.Value
If FunOk(stringa1) = True Then Cancel = True: Text1.Value = "": Beep: MsgBox _
"Input non valido !"
End Sub

La nostra Funzione è stata chiamata "FunOK" e restituisce un valore booleano (True o False) che ci dirà se la stringa proposta dovrebbe essere respinta o no. Per analizzare la funzione useremo la variabile stringa1 a cui viene assegnato il valore della TextBox. La funzione "FunOK", presenta di default il valore False, mentre se il valore è True, la stringa viene scartata.

FunOK If (stringa1) = True Then Cancel = True: Text1.Value = " "Beep: MsgBox" Input non valido "

Che sta a indicare: Se il valore di ritorno è True, quindi il parametro Annulla della macro è vero, vuol dire che hai inserito una stringa vuota nel controllo TextBox, emetti un segnale acustico e visualizza il messaggio "Input non valido !". Per verificare se la stringa è vuota non c'è bisogno di avviare un processo, per questo, utilizziamo una nuova istruzione IF Then Else auto-esplicativa come la seguente:

If stringa1 = "" Then Exit Function

Mentre invece se non include nessun segno possiamo usare un’altra istruzione If Then Else nella forma:

If Len(Replace(stringa1, ".", "")) <> Len(stringa1) Then FunOK = True: Exit Function

Da ricordare che la funzione Len restituisce un valore long che contiene il numero di caratteri di una stringa, pertanto se la lunghezza della stringa ottenuta sostituendo il punto con una stringa vuota è diversa dalla lunghezza della stringa di base, significa che la nostra stringa ha un punto e quindi viene assegnato il valore di riferimento come True alla nostra funzione e il valore sarà respinto. Se invece la stringa ha un solo carattere, che non è parte di una delle 10 cifre permesse, allora viene rifiutata in questo modo:

If Len(stringa1) = 1 And InStr("1234567890", stringa1) = 0 Then FunOK = True: Exit Function

Il codice sopra esposto sta a indicare che: Se la lunghezza della stringa è uguale a 1 e non troviamo nessuna corrispondenza con le 10 cifre permesse, allora si assegna il valore True come valore di ritorno alla funzione e il valore verrà respinto. Dopo le prime operazioni eseguite, resta ora quello di assicurarsi che la stringa corrisponda a un numero secondo i nostri desideri (numeri da 0 a 9, un possibile punto positivo o negativo). Per fare questo, sarebbe conveniente utilizzare la funzione Val che restituisce il numero contenuto in una stringa come un valore numerico di tipo appropriato e se non viene trovato un numero restituisce 0 e non un messaggio di errore. A sfavore di questa funzione c’è che le virgole non sono riconosciute, infatti l'editor di VBA riconosce solo il punto come separatore numerico. Quindi dovremo trattare la stringa per testare la sostituzione (solo per le prove) della virgola, potenzialmente esistente, con il punto che ci consente di utilizzare la funzione Val con il seguente codice:

stringa1 = Replace(stringa1, ",", ".")

A questo livello, ci si baserà su questo ulteriore caratteristica della funzione Val, in cui la funzione interrompe la lettura della stringa in corrispondenza del primo carattere che non è una parte evidente di un numero. E' questo quello che ci interessa, infatti, se si tratta di una sequenza eterogenea di caratteri che comprende lettere nel mezzo di numeri, la lettura della funzione Val si ferma al primo carattere non permesso incontrato. Allora possiamo costruire, come sopra, il metodo per confrontare la lunghezza della stringa risultante con l'originale e vedere, ovviamente, la differenza. Si deve ricordare che la funzione Len si occupa solo di lunghezze di stringhe, poi attraverso l'utilizzo della funzione Val viene convertita in un'espressione numerica, e in seguito con la funzione CStr si converte un'espressione numerica in una stringa. Possiamo utilizzare un codice come il seguente:

If Len(CStr(Val(stringa1))) <> Len(stringa1) Then FunOK = True

Che consiste in: Se la lunghezza della stringa costituita dal primo carattere numerico incontrato, prima di un carattere nella stringa da testare, è diversa dalla lunghezza di quest'ultimo, vuol dire che c’è un carattere indesiderato, quindi influisce sul valore restituito, cioè True alla funzione e l’inserimento verrà respinto. A questo punto resta da scrivere il valore nell'apposita cella del foglio di lavoro che possiamo farlo usando il seguente codice:

Private Sub command1_Click()
Cells(5, 1) = Text1.Value
End Sub

E otteniamo:

Fig. 1

L'allineamento predefinito a sinistra del nostro valore nella casella A5 indica che i dati scritti sono stati considerati come una stringa, come conferma l'attivazione del pop-up:

Fig. 2

Si prega di notare questo comportamento, che è la causa di molti malintesi, perché se includiamo quella cella in un calcolo come "= A5 + A7" con un numero in A7, avremo un risultato, mentre se si utilizza la funzione SOMMA "= Somma (A5 : A7)", il valore di A5 non sarà preso in considerazione, perchè, ancora una volta, è normale e segue le regole di interpretazione di Excel. Finora abbiamo visto un TextBox che restituisce valori di stringa, ma possiamo convertire il valore nel formato numerico oppure secondo i criteri della cella di destinazione usando il seguente codice:

Private Sub scrivi1_Click()
Cells(5, 3) = CDbl(Text1.Value)
End Sub

La funzione CDbl converte un'espressione (che può essere qualsiasi espressione stringa o un'espressione numerica) in una variabile di tipo Double, possiamo verificare scrivendo il valore nella cella C5 (verde) per visualizzare il risultato.

Fig. 3

Possiamo completare il codice per raggiungere i due tipi di dati da scrivere nella cella e vederne i risultati in questo modo:

Private Sub scrivi1_Click()
   MsgBox "Questo tipo di dati è :  " & TypeName(Text1.Value) & vbCr & vbLf _
   & "e abbiamo il testo nella cella A5 con allineamento predefinito a sinistra."
   Worksheets("Foglio1").Cells(5, 1) = Text1.Value

   Worksheets("Foglio1").Cells(5, 3) = CDbl(Text1.Value)
   MsgBox "Questo tipo di dati è :  " & TypeName(CDbl(Text1.Value)) & vbCr & vbLf _
   & "e abbiamo un numero in virgola mobile nella cella C5 con allineamento predefinito a destra"
End Sub

Il fatto di avere le colonne A e C estese, mette in evidenza le differenze di allineamento a causa del formato, è molto meno visibile (e fuorviante) sotto le colonne di base in funzione del numero di cifre!. In questa ultima fase abbiamo impiegato la funzione TypeName per visualizzare nel messaggio informativo che restituisce se una stringa corrisponde al tipo di una variabile. A questo punto il listato finale è il seguente:

Option Explicit
Private Sub scrivi1_Click()
   MsgBox "Questo tipo di dati è :  " & TypeName(Text1.Value) & vbCr & vbLf _
   & "e abbiamo il testo nella cella A5 con allineamento predefinito a sinistra."
   Worksheets("Foglio1").Cells(5, 1) = Text1.Value
   
   Worksheets("Foglio1").Cells(5, 3) = CDbl(Text1.Value)
   MsgBox "Questo tipo di dati è :  " & TypeName(CDbl(Text1.Value)) & vbCr & vbLf _
   & "e abbiamo un numero in virgola mobile nella cella C5 con allineamento predefinito a destra"
End Sub

Private Sub Text1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim stringa1 As String
   stringa1 = Text1.Value
   If FunOK(stringa1) = True Then Cancel = True: Text1.Value = "": Beep: MsgBox "Input non Valido !"
End Sub

Private Function FunOK(stringa1 As String) As Boolean
   If stringa1 = "" Then Exit Function
   If Len(Replace(stringa1, ".", "")) <> Len(stringa1) Then FunOK = True: Exit Function
   If Len(stringa1) = 1 And InStr("1234567890", stringa1) = 0 Then FunOK = True: Exit Function
   stringa1 = Replace(stringa1, ",", ".")
   If Len(CStr(Val(stringa1))) <> Len(stringa1) Then FunOK = True
End Function

Private Sub Text1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If InStr("1234567890,-", Chr(KeyAscii)) = 0 Or Text1.SelStart > 0 And Chr(KeyAscii) = "-" _
     Or InStr(Text1.Value, ",") <> 0 And Chr(KeyAscii) = "," Then
      KeyAscii = 0: Beep
   End If
End Sub

[Alexsandra]

Macro e Procedure varie riferite alle righe


=> Trovare l'ultima riga che contiene dati nella colonna A
Nota: Le seguenti routine riportano il numero dell’ultima riga contenente un valore

Sub ultima_riga1()
    Dim UltimaR As Long
    With ActiveSheet
        UltimaR = .Cells(.Rows.count, "A").End(xlUp).Row
    End With
    MsgBox UltimaR
End Sub

'oppure

Sub ultima_riga2()
UltimaR = Range("A" & Rows.Count).End(xlUp).Row
MsgBox UltimaR
End Sub

'oppure

Sub ultima_riga3()
UltimaR = Cells(Rows.Count, 1).End(xlUp).Row
MsgBox UltimaR
End Sub

'oppure

Sub ultima_riga4()
UltimaR = Sheets("Foglio1").Range("A1").End(XlDown).Row
MsgBox UltimaR
End Sub

=> Trovare il valore dell'ultima cella
Nota: Questa routine riporta il valore presente nell’ultima riga contenente dati della colonna A

Sub trova1()
ultima = [A1].End(xlDown) 
MsgBox ultima 
End Sub

=> Eliminare righe vuote
Nota: Alcune routine che scorrono la colonna A e cancellano le righe vuote

Sub eliminaR1()
Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

'oppure

Sub eliminaR2()
Range("A:A").SpecialCells(xlCellTypeBlanks).Delete (xlShiftUp)
End Sub

'oppure

Sub EliminaR3()
Dim rng As Range, fgl As Boolean
Dim Righe, R
Set rng = ActiveSheet.UsedRange
Righe = rng.Rows.Count
For R = 1 To Righe
If rng(R, 1) = "" Then
rng(R, 1).EntireRow.Delete
End If
Next
End Sub

'oppure

Sub EliminaR4()
With ActiveSheet.UsedRange
rigaI = .Row + .Rows.Count - 1
End With
Application.ScreenUpdating = False
For R = rigaI To 1 Step -1
If Application.CountA(Rows(R)) = 0 Then Rows(R).Delete
Next R
End Sub

=> Cancellare le righe scelte
Nota: Inserendo il numero delle righe separato dalla virgola vengono cancellate le righe scelte

 Sub test()
CancellaR "3,6,9"
End Sub

Sub CancellaR(myR As String)
Dim sR() As String, i As Long
sR = Split(myR, ",")
For i = UBound(sR) To LBound(sR) Step -1
Rows(sR(i)).Delete
Next
End Sub

=> Cerca e nasconde righe doppie

Sub NascondiRD()
Dim cell As Range, nasc As Range, ult As Long
Application.ScreenUpdating = False
ult = Cells(Rows.count, 1).End(xlUp).Row
For i = ult To 2 Step -1
If Not IsError(Application.Match(Cells(i, 1).Value, _
Range("A1:A" & i - 1), 0)) Then
If nasc Is Nothing Then
Set nasc = Cells(i, 1)
Else: Set nasc = Union(nasc, Cells(i, 1))
End If
End If
Next i
If Not nasc Is Nothing Then _
nasc.EntireRow.Hidden = True
End Sub

=> Cancella le righe doppie

 Sub Cancella_uguali()
Dim cell As Range, righeS As Range, rigaP As Long

Application.ScreenUpdating = False
rigaP = Cells(Rows.count, 1).End(xlUp).Row
For i = 1 To rigaP
If Cells(i, 1) = Cells(i + 1, 1) Then
If righeS Is Nothing Then
Set righeS = Cells(i + 1, 1)
Else: Set righeS = Union(righeS, Cells(i + 1, 1))
End If
End If
Next i
If Not righeS Is Nothing Then righeS.EntireRow.Delete
End Sub

=> Bloccare la prima riga di un foglio

Sub Blocca_riga()
Rows("2:2").Select
ActiveWindow.FreezePanes = True
End Sub

=> Seleziona la riga della cella attiva

Sub seleziona()
Range(ActiveCell.Address & ":" & ActiveCell.End(xlToRight).Address).Select
End Sub

=> Conoscere il numero di riga della cella attiva

Sub riga1()
riga = ActiveCell.Row
MsgBox riga
End Sub

=> Contare le righe in un Range

Sub conta_righe()
[A1].Select
ActiveCell.CurrentRegion.Select
conta = Selection.count
MsgBox "La selezione contiene " & Selection.Rows.count & " righe"
End Sub

=> Inserire una riga sotto la cella attiva

Sub InserireS()
ActiveCell(2).Resize(1).EntireRow.Insert
End Sub

=> Selezionare varie righe

Sub selezionaR()
Dim rg As String, lung As Integer, sel As Range
rg = InputBox("Inserisci il N° di righe che vuoi selezionare?")
'inserire il n° di riga nella forma 3,6,9
lung = Len(rg)
On Error Resume Next
selR = Application.WorksheetFunction.Search(",", rg, 1)
If selR = "" Then
Range(Cells(Left(rg, lung), 1), Cells(Left(rg, lung), 7)).Select
Else
selR = Application.WorksheetFunction.Search(",", rg, 1)
riga = Left(rg, selR)
rgLun = Len(riga)
Range(Cells(Left(riga, rgLun), 1), Cells(Left(riga, rgLun), 7)).Select
For i = 2 To lung
On Error Resume Next
selR = Application.WorksheetFunction.Search(",", rg, 1)
riga = Left(rg, selR)
rgLun = Len(riga)
Union(Selection, Range(Cells(riga, 1), Cells(riga, 7))).Select
rg = Mid(rg, rgLun + 1, lung)
Next i
End If
End Sub

[Alexsandra]

Macro e Procedure varie riferite alle Colonne


=> Nascondere una colonna
Nota: Si deve inserire nell’inputBox il valore della colonna in lettere. Es. A – B etc.

Sub nascondiC()
Dim foglio As Worksheet
col = InputBox("Quale colonna vuoi nascondere ?")
col2 = col & ":" & col
Columns(col2).Select
Selection.EntireColumn.Hidden = True
End Sub

=> Conoscere la lettera della colonna dal numero
Nota: Viene riportata la lettera della colonna in base al valore numerico della variabile lettera

Sub Test()
MsgBox letteraC(3)
End Sub

Function letteraC(numeroC)
Dim S As String
If numeroC < 1 Or numeroC > 256 Then Exit Function
S = Cells(1, numeroC).Address(1, 0)
letteraC = Left(S, InStr(1, S, "$") - 1)
End Function

’oppure

Function letteraC(Numero) As String
letteraC = Split(Cells(1, Numero).Address, "$")(1)
End Function

=> Conoscere la lettera della colonna della cella attiva
Nota: Funzione per conoscere la lettera della colonna della cella attiva

Function letteraCol(cell As Range)
letteraCol = Left$(cell.Address(0, 0), (cell.Column < 27) + 2)
End Function

Sub test()
MsgBox letteraCol(ActiveCell)
End Sub

=> Proteggere l’accesso alle colonne in base all’utente che accede al file
Nota: Permette di consentire di accedere a determinate colonne in base al nome utente di rete. Il codice è da copiare in ThisWorkbook. Autore: Norman Jones

Private Sub Workbook_Open()
Dim WS As Worksheet
Const PWORD As String = "pippo"

For Each WS In Me.Worksheets
With WS
.Unprotect Password:=PWORD
.Cells.Locked = False
If Environ("USERNAME") = "Alex" Then
.Range("D:D").Cells.Locked = True
ElseIf Environ("USERNAME") = "Gino" Then
.Range("A:C").Cells.Locked = True
Else
.Range("A:D").Cells.Locked = True
End If
WS.Protect Password:=PWORD, _
UserInterfaceOnly:=True
End With
Next
End Sub

[Alexsandra]

Macro e Procedure varie riferite alle Celle


=> Trovare la prima cella vuota

Sub cellaV()
If Range("A1").Value = "" Then
Range("A1").Select
Else
If Range("A1").Value <> "" And Range("A2").Value = "" Then
Range("A2").Select
Else:
Worksheets("Foglio1").Range("A1").End(xlDown).Offset(1, 0).Select
End If
End If
End Sub

=> Identificare il tipo di dati contenuto nelle celle

Public Sub IdentificaCel()
    Dim RigheT As Long, conT As Long
    conT = 1
    Range("A1").Select
    Selection.End(xlDown).Select
    RigheT = Cells(Rows.count, 1).End(xlUp).Row + 1
    While RigheT > conT
        If Left(Cells(conT, 1).Formula, 1) = "=" Then
            Cells(conT, 2).Value = "Formula: " & Cells(conT, 1).Formula
        Else
            If IsNumeric(Cells(conT, 1)) Then
                Cells(conT, 2).Value = "Numerico"
            Else
                Cells(conT, 2).Value = "Testo"
            End If
        End If
        conT = conT + 1
    Wend
End Sub

=> Aggiunge del testo in una cella in cui è presente altro testo
Nota: Aggiunge il testo presente in una cella alle celle dell’intervallo

 Sub Testo()
Dim cel1 As String, cel2 As String, cel As Range, testo1 As String
Range("A1:A10").Select
testo1 = Range("B4").Value
Application.ScreenUpdating = False
cel1 = ActiveCell.Address
cel2 = ActiveCell.End(xlDown).Address
Range(cel1 & ":" & cel2).Select
For Each cel In Selection
cel.Value = cel.Value & " " & testo1
Next cel
Range(cel1).Select
End Sub

=> Selezionare un intervallo
Nota: Inserire nella finestrella di Input l’intervallo da selezionare, digita ad esempio C3:E10 oppure A1:C10,J9:J12

Sub Selezionare()
Dim tit As String, Mess As String, cont As Variant
tit = "Forum di VBA per Excel"
Mess = "Digita l'intervallo di celle"
cont = Application.InputBox(Mess, tit)
Range(cont).Select
End Sub

=> Funzione somma in un range

Sub Somma()
Set zona = Range([B3], [B3].End(xlDown))
[B3].End(xlDown).Select
ActiveCell.Offset(1, -1) = "Totale"
ActiveCell.Offset(1, 0) = WorksheetFunction.Sum(zona)
End Sub

=> Eseguire una macro quando la cella A10 è selezionata

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$10" Then pippo
End Sub

=> Allineamento contenuto delle celle

ActiveCell.HorizontalAlignment = xlRight ' a destra
ActiveCell.HorizontalAlignment = xlLeft ' a sinistra
ActiveCell.HorizontalAlignment = xlCenter ' al centro

=> Inserire una formula nella cella
Note: Se viene usata la proprietà Formula, la formula deve esser in inglese, se invece si usa la
proprietà FormulaLocal, la formula deve essere nella lingua del vostro Excel. Autore : Tiziano Marmiroli

Worksheets("Foglio1").Range("C3").Formula=("=SUM(A1:A10)")
'oppure
Worksheets("Foglio2").Range("C3").FormulaLocal=("=SOMMA(A1:A10)")

=> Far lampeggiare una cella

Sub Lampeggiacella()
Const testo1 As String = "Lampeggio"
Dim i As Integer
For i = 1 To 10
Cells(1, 1) = testo1
Call Lamp_cell
Next i
End Sub

Private Sub Lamp_cell()
Dim n As Byte, Start As Variant
For n = 1 To 10
Start = Timer
Do While Timer < Start + 1 / 100
Loop
If n Mod 5 = 0 Then Cells(1, 1) = ""
Next n
End Sub

=> Sapere se le celle di una zona sono vuote

Sub vuote1()
With [A1:A10]
n = Application.CountBlank(.Cells)
If .Cells.count = n Then
MsgBox "La cella e vuota"
ElseIf n = 0 Then
MsgBox "Le Celle sono piene"
Else
MsgBox "Solo alcune celle sono vuote"
End If
End With
End Sub

=> Trasformare la prima lettera in maiuscolo
Nota : Metodo per convertire la prima lettera di una frase in maiuscolo

Sub Test1()
MsgBox Frase("benvenuto, al corso VBA")
End Sub

Public Function Frase(Stc As String)
Frase = UCase(Left(Stc, 1)) & Right(Stc, Len(Stc) - 1)
End Function

[Alexsandra]

Macro e Procedure varie riferite al foglio di lavoro


=> Mostra tutti i fogli della cartella aperta

Sub ScorreFogli()
For i = 1 To Worksheets.Count
With Worksheets(i)
.Activate
MsgBox .Name
End With
Next
End Sub

=> Selezionare tutti i fogli di una cartella

Sub SelezionaFogli()
Dim myarray()
ReDim myarray(1 To ActiveSheet.Index)
For i = 1 To ActiveSheet.Index
myarray(i) = i
Next i
Worksheets(myarray).Select
End sub

=> Proteggi e sproteggi tutti i fogli

Sub Proteggere()
Dim fgl As Integer
fgl = ActiveWorkbook.Sheets.count
Application.ScreenUpdating = False
For i = 1 To fgl
Worksheets(i).Protect Password:="blabla"
Next i
End Sub

Sub sproteggere()
Dim fgl As Integer
fgl = ActiveWorkbook.Sheets.count
Application.ScreenUpdating = False
For i = 1 To fgl
Worksheets(i).Unprotect Password:="blabla"
Next i
End Sub

=> Crea intervallo in un foglio

Private Sub Worksheet_Deactivate()
Dim mioadd As String
mioadd = Sheets("Foglio2").Range(Sheets("Foglio2").Cells(2, 1), Sheets("Foglio2").Cells(65536, 1).End(xlUp)).Address
ActiveWorkbook.Names.Add Name:="Codice", RefersTo:="=Foglio2!" & mioadd
mioadd = Sheets("Foglio2").Range(Sheets("Foglio2").Cells(2, 1), Sheets("Foglio2").Cells(65536, 3).End(xlUp)).Address
ActiveWorkbook.Names.Add Name:="Dati", RefersTo:="=Foglio2!" & mioadd
Sheets("Foglio2").Range("A1").Sort Key1:=Sheets("Foglio2").Range("A1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub

=> Verificare che un Foglio esista
Nota: Riporta il valore True se il foglio esiste oppure False per il contrario

Sub test()
MsgBox foglioE("fogliol1")
End Sub

Function foglioE(Nom$) As Boolean
On Error Resume Next
foglioE = Sheets(Nom).Name <> ""
Err.Clear
End Function

=> Proteggere un foglio usando UserInterfaceOnly

Sub ProtectionOn()
On Error Resume Next
For Each sht In ActiveWorkbook.Worksheets
With sht
.Select
.Protect Password:="pippo", UserInterfaceOnly:=True
End With
Next
End Sub

=> inserire un commento con un formato diverso dello standard

Sub Inscommento()
With ActiveCell.AddComment.Shape.OLEFormat.Object
 .Text = ""
 .Font.Name = "Calibri"
 .Font.Size = 12
End With
ActiveCell.Comment.Visible = True
ActiveCell.Comment.Shape.Select True
End Sub

=> Cambiare formato a un commento

Sub Ins_Comm()
Dim riga1, riga2, riga3, riga4, riga5, testo
Range("A1").ClearComments
[color=green]'creazione testo del commento
riga1 = vbLf & Application.UserName & ", " & Format(Date, "dd/mm/yyyy") & " :" & vbLf
riga2 = "Configurazione del computer :" & vbLf
riga3 = "- " & Application.OperatingSystem & vbLf
riga4 = "- Versione Excel : " & Application.Version & vbLf
riga5 = " Solo un esempio" & vbLf
testo = riga1 + riga2 + riga3 + riga4 + riga5
With Cells(1, 1).AddComment(testo).Shape.OLEFormat.Object.Font
'Tipo e dimensione carattere
.Name = "Arial" 
.Size = 10
End With
With Cells(1, 1).Comment.Shape
.AutoShapeType = msoShapeExplosion1
.TextFrame.AutoSize = True
'colore sfondo del commento
.OLEFormat.Object.Interior.ColorIndex = 24
 'colore del bordo
.Line.ForeColor.SchemeColor = 10
'stile del bordo (doppio per questo esempio)
.Line.Weight = 3# 
'spessore del bordo
.Line.Style = msoLineThinThin 
'1° riga in grassetto
.TextFrame.Characters(1, Len(riga1)).Font.Bold = True 
testo = riga1 + riga2 + riga3 + riga4
With .TextFrame.Characters(Len(testo) + 1, Len(riga5)).Font
'ultima riga in grassetto e di dimensioni diverse
.Bold = True 
.Size = 16
End With
End With
End Sub

=> Inserire un’immagine in un commento
Nota: Viene mostrata la finestra di scelta dei file per Inserire un’immagine come sfondo nel commento

Sub Imgcommento()
Range("A1").Comment.Delete
Range("A1").AddComment
ChDrive "C"
ChDir "C:\Test\"
ImgFile = Application.GetOpenFilename
If ImgFile = False Then Exit Sub
With Range("A1").Comment
.Shape.Fill.UserPicture ImgFile
End With
End Sub

=> Copiare il formato di un foglio in un altro foglio
Nota : Permette di copiare il formato di un foglio in un altro foglio. Copia soltanto il formato.

Sub test()
copiaFF "Foglio1", "Foglio2"
End Sub

Sub copiaFF(origine As String, target As String)
Sheets(origine).Cells.Copy
Sheets(target).Cells.PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
End Sub

=> Reperire il nome del foglio precedente e seguente al foglio attivo

Sub foglioS()
ActiveSheet.Next.Select
End Sub

Sub foglioP()
ActiveSheet.Previous.Select
End Sub

=> Verifica se un dato inserito esiste già
Nota: L'esempio seguente verifica, mentre si sta inserendo un nome oppure un numero, se quest'ultimo sia gia' stato inserito: Autore: Microsoft

Sub auto_open()
Worksheets("Foglio1").OnEntry ="Verifica"
End Sub

Sub Verifica()
valor = ActiveCell.Value
Selection.End(xlUp).Select
varinizio = ActiveCell.Row
Selection.End(xlDown).Select
varfine = ActiveCell.Row - 1
For y = varinizio To varfine
If Cells(y, 1).Value = valor Then
MsgBox "Nominativo gia’ esistente"
End If
Next y
End Sub

[Alexsandra]

Macro e Procedure varie riferite alle Userform


=> Link email in una Userform

Private Sub email_lnk_Click()
Link = "mailto:president@italy.gov"
On Error GoTo No_Sped
ActiveWorkbook.FollowHyperlink Address:=Link, NewWindow:=True
Unload Me
Exit Sub
No_Sped:
MsgBox "Impossibile aprire" & Link
End Sub

=> Link sito web in una Userform

Private Sub web_lnk_Click()
Link = "http://www.italy.gov"
On Error GoTo No_Sped
ActiveWorkbook.FollowHyperlink Address:=Link, NewWindow:=True
Unload Me
Exit Sub
No_Sped:
MsgBox "Impossibile aprire" & Link
End Sub

=> Disabilita la x di chiusura in una form

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Cancel = vbNo
MsgBox "Per uscire devi cliccare su [ Esci dal Programma ]"
End Sub

=> Avviare una macro una volta sola
Nota: Eseguire una macro una volta sola e poi la procedura viene cancellata.

Private Sub Workbook_Open()
Dim Lin_In, Lin_Fi
Msg = "La procedura Workbook Open e terminata "
ActiveSheet.Range("A1").Value = Msg
With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
  Lin_In = .ProcStartLine("Workbook_Open", 0)
  Lin_Fi = .ProcCountLines("Workbook_Open", 0)
   .DeleteLines Lin_In, Lin_Fi
End With
End Sub

=> Eseguire una macro quando una userform è attiva

sub Form_V()
If UserForm1.Visible = True Then
MsgBox "Buongiormo" 'Macro1
Else MsgBox "Arrivederci" 'Macro2
End If
end sub

=> Chiudere una Userform dopo cinque secondi

Private Sub UserForm_Activate()
    Application.OnTime Now + TimeValue("00:00:5"), "Chiude"
End Sub

Private Sub UserForm_Initialize()
    Label1.Caption = "Active sheet: " & ActiveWorkbook.ActiveSheet.Name
End Sub

Private Sub CommandButton1_Click()
    UserForm1.Hide
End Sub

' E in un modulo standard inserire 
Sub chiude()
UserForm1.Hide
End Sub

=> Formato del testo in un listbox

ListBox1.Font.Name = "Calibri"
ListBox1.Font.Italic = True
ListBox1.Font.Size = 12

=> Ridurre finestra
Nota: Copiare il codice nel Workbook in cui volete ridurre la finestra, così all'apertura, la finestra sarà sempre piccola. Autore: Marco Gamberini

Private Sub Workbook_BeforeClose(Cancel As Boolean)
ActiveWindow.WindowState = xlMaximized
End Sub

Private Sub Workbook_Open()
ActiveWindow.WindowState = xlMinimized
End Sub

=> Visualizzare una userform a tutto schermo
Nota: Una macro per visualizzare una Userfom, senza vedere Excel. Autore N. Jones

Private Sub Workbook_Open()
'Nel modulo ThisWorkbook
UserForm1.Show
End Sub

Private Sub UserForm_Initialize()
'Nel modulo dell'Userform
With Application
.Visible = False
Me.Top = .Top
Me.Left = .Left
Me.Height = .Height
Me.Width = .Width
End With
End Sub

Private Sub UserForm_Terminate()
With Application
.Visible = True
End With
End Sub

=> Scegliere dove far comparire una Userform
Nota : Permette di imporre dove fare comparire un userform e di non potere spostarlo

Private Sub UserForm_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
UserForm1.Left = 100
UserForm1.Top = 100
End Sub

=> Posizionare una Userform a destra dello schermo
Commento : Permette di postare la Userform su un lato dello schermo Autore: M. Pierron

Sub Visalizza()
With UserForm1
.StartUpPosition = 0
.Left = Application.UsableWidth - .Width
.Top = Application.UsableHeight - .Height
.Show
End With
End Sub

=> Testo scorrevole in una userform
Commento : Permette, dopo avere creato un oggetto label, di fare sfilare un testo sull'userform Autore : Hervé

 Private Declare Function GetTickCount Lib "Kernel32" () As Long
Public Fermare As Boolean
Dim Testo As String

Public Sub Crono()
Dim Top As Long
Do
If Fermare = True Then Exit Do
Top = GetTickCount()
Do While GetTickCount() < Top + 70
DoEvents
Loop
DoEvents
Messaggio
DoEvents
Loop
End Sub

Sub Messaggio()
Dim Testo1 As String, Testo2 As String
With Label1
Testo2 = Left(.Caption, Len(Testo) - Len(.Caption) + 1)
Testo1 = Right(.Caption, Len(.Caption) - 1) & Testo2
.Caption = Testo1
End With
End Sub

Private Sub UserForm_Activate()
Crono
End Sub
Private Sub UserForm_Click()
Fermare = Not Fermare
End Sub

Private Sub UserForm_Initialize()
Testo = "Questo è un esempio " & _
"di messaggio scorrevole " & _
"inserito in una Userform !" & Space(5)
With Label1
.Caption = Testo
.Font.Bold = True
End With
End Sub

=> Formato testo in un Textbox

'La data 01/01/2001 :
TextBox1.Value = Format(TextBox1.Value, "dd/mm/yyyy")

'Un numero 1 251:
TextBox2.Value = Format(TextBox2.Value, "#,##0.00 [$?-40C]")

'Un numero di telefono : 02 04 55 55 55
TextBox3.Value = Format(TextBox3.Value, "00"" ""00"" ""00"" ""00"" ""00")

[Alexsandra]

Macro e Procedure varie riferite ai File


=> Crea un file txt

Sub messaggio()
Sheets.Add
ActiveSheet.Move
Dim MiaUn As String
MiaUn = Left(CurDir, 3)
ActiveWorkbook.SaveAs Filename:=MiaUn & "Messaggio", FileFormat:=xlTextMSDOS, CreateBackup:=False
Cells(2, 1) = "Ragione Sociale"
Cells(2, 2) = Application.OrganizationName
Cells(3, 1) = "e-mail"
Cells(4, 1) = "telefono"
Cells(4, 2) = "quello che vuoi"
Cells(6, 2) = "altri dati, oggetto o quello che vuoi"
Cells(7, 2) = "testo del messaggio"
Cells(8, 2) = "altro testo"
Cells(9, 2) = "ancora testo"
ActiveWindow.Zoom = 85
Columns(1).ColumnWidth = 18
Columns(2).ColumnWidth = 50
Columns(3).ColumnWidth = 50
Range("B3:B4").Select
Selection.Font.Size = 16
Selection.Interior.ColorIndex = 34
Selection.Locked = False
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayHeadings = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

=> Verifica se un file è già aperto prima di salvarlo

Sub test()
nome = InputBox("Nome")
flag = 0
For Each p In Workbooks
If w.Name = pippo Then
flag = 1
End If
Next w
If flag = 1 Then
MsgBox ("Il file esiste")
Else
MsgBox ("File inesistente")
End If
End Sub

=> Scrivere in un file txt

Sub scrivi()
Open "C\:prova.txt" For Output As #1
r = 1
Print #1, "Nel magazzino ho:"
While Cells(r, 1) <> ""
Print #1, Cells(r, 2); " "; Cells(r, 1)
r = r + 1
Wend
Close #1
End Sub

=> Distruggere un file
Nota: Attenzione, questa macro distrugge il file per sempre

Sub Distruzione()
Dim FName As String, Ndx As Integer
With ThisWorkbook
.Save
For Ndx = 1 To Application.RecentFiles .Count
If Application.RecentFiles(Ndx).Path = .FullName Then
Application.RecentFiles(Ndx).Delete
Exit For
End If
Next Ndx
.ChangeFileAccess Mode:=xlReadOnly
Kill .FullName
.Close SaveChanges:=False
End With
End Sub

=> Vedere le proprietà del documento

 Sub Prop_doc()
rw = 1
Worksheets.Add
On Error Resume Next
For Each p In ActiveWorkbook.BuiltinDocumentProperties
Cells(rw, 1).Value = p.Name
Cells(rw, 2).Value = p.Type
Cells(rw, 3).Value = p.Value
rw = rw + 1
Next
End Sub

=> Elencare le proprieta di un file
Nota: Ritorna tutte le proprietà della cartella attiva.

Sub Proprieta()
Dim I As Integer, txt As String
Sheets.Add
On Error Resume Next
With ThisWorkbook.BuiltinDocumentProperties
For I = 1 To .Count
Cells(I, 1) = .Item(I).name
Cells(I, 2) = .Item(I)
Next I
End With
Cells(I + 2, 1) = FileLen(ThisWorkbook.FullName) & " octets"
Columns("A:B").AutoFit
[B11:B12].NumberFormat = "dd/mm/yyyy hh:mm:ss"
End Sub

'altro metodo

Sub TestInfos()
MsgBox ShowFileInfos(ThisWorkbook.FullName)
End Sub

Function ShowFileInfos(filespec)
Dim fso, f, s
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(filespec)
s = UCase(filespec) & vbLf
s = s & "Creato il : " & f.DateCreated & vbLf
s = s & "Ultimo accesso il : " & f.DateLastAccessed & vbLf
s = s & "Ultima modifica il : " & f.DateLastModified & vbLf
s = s & "Tipo di file : " & f.Type & vbLf
s = s & "Taglia : " & f.Size
ShowFileInfos = s
End Function

=> Copiare il contenuto di un file senza aprirlo

Sub CopyAllFiles()
Dim oFso As Object
Set oFso = CreateObject("Scripting.FileSystemObject")
oFso.CopyFile "C:\1BACK\*.*", "M:\2BACK\", True
MsgBox ("ok fatto")
End Sub

Sub CopyOneFiles()
Dim oFso As Object
Set oFso = CreateObject("Scripting.FileSystemObject")
oFso.CopyFile "C:\1BACK\pippo.xls", "M:\2BACK\", True
MsgBox ("ok fatto")
End Sub

[Alexsandra]

Macro e Procedure varie



=> Annullare ogni azione - Undo in VBA

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End Sub

=> Avviare una macro premendo un tasto qualsiasi

Private Sub Workbook_Activate()
For i = 1 To 250
On Error Resume Next
Application.OnKey Chr(i), "Macro1"
Next i
End Sub

=> Inserisci un collegamento ipertestuale

Sub Add_Hyp()
    With ThisWorkbook.Sheets(2)
        .Activate
        .Hyperlinks.Add Range("A1"), "http://www.microsoft.com"
        .Shapes.AddShape msoShapeExplosion2, 45, 55, 90, 45
        .Hyperlinks.Add .Shapes(1), "http://www.microsoft.com"
    End With
End Sub

=> Incollare solo il valore

Sub IncVal()
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
If ActiveCell.Text = "#N/D" Then ActiveCell = ""
End Sub

=> Ordina dati in decrescente
Nota: Ordinare i dati in base al valore presente nella cella D2

Sub ordina()
Range("A2:F5").Select
Selection.Sort Key1:=Range("D2"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select
End Sub

=> Eseguire una macro a un'ora prefissata
Nota: Una macro che viene eseguita ad un’ora precisa, usando la funzione Ontime.

Private Sub Workbook_Open()
Application.OnTime TimeValue("22:00:00"), "Macro1"
End Sub

=> Avvia una macro con un clik sulla cella

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$A$1" Then MsgBox "forza !" 'Macro1
End Sub

=> Giorno della settimana e data

Sub giornoedata()
Dim x As Date
x = Date
[B2] = Format(x, "dddd") & Space(2) & "-" & Space(2) & x 
End Sub

=> Eseguire un programma con "ritardo"

Sub Test()
Sleep NumSeconds:=10
Shell ("percorso e nome programma")
End Sub

Sub Sleep(NumSeconds As Single)
Dim StartTime As Single
StartTime = Timer
While (Timer - StartTime) < NumSeconds
DoEvents
Wend
End Sub

=> Funzione somma in un range

Sub Somma()
Set zona = Range([B3], [B3].End(xlDown))
[B3].End(xlDown).Select
ActiveCell.Offset(1, -1) = "Totale"
ActiveCell.Offset(1, 0) = WorksheetFunction.Sum(zona)
End Sub

=> Eseguire una macro quando la cella A3 è selezionata

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$3" Then pippo
End Sub

=> Cambiare i punti con le virgole

Sub CambiaPuntiVirgole()
For Each cell In Selection
If InStr(1, cell.Text, ".") > 0 Then
cell.Value = CDbl(Val(cell.Text))
End If
Next
End Sub

=> Togliere gli apostrofi
Nota : Toglie tutti gli apostrofi nelle celle

Sub app1()
For Each cell In ActiveSheet.UsedRange
If cell.PrefixCharacter <> "" Then
cell.Formula = cell.Formula
End If
Next cell
End Sub

=> Sostituisce un carattere vietato con il carattere "_"
Nota : Questa funzione cambia i caratteri vietati per il nome del file, con il carattere "_".

Function sost_car(fileName As String) As String
Dim illegal As Variant, counter As Integer
illegal = Array("<", ">", "?", "[", "]", ":", "|", "*", "/")
For counter = LBound(illegal) To UBound(illegal)
Do While InStr(fileName, illegal(counter))
Mid(fileName, InStr(fileName, illegal(counter)), 1) = "_"
Loop
Next counter
ReplaceIllegalChars = fileName
End Function

=> Salvare la cartella senza le macro

Sub senzaM()
ThisWorkbook.Sheets.Copy
ActiveWorkbook.SaveAs MyNewPathAndFile
ThisWorkbook.Close False
End Sub

=> Conoscere il codice Ascii di un testo

Function CodASCII$(txtin$)
Dim i As Integer
CodASCII = ""
For i = 1 To Len(txtin)
CodASCII = CodASCII & Asc(Mid(txtin, i, 1))
If i < Len(txtin) Then
CodASCII = CodASCII & "."
End If
Next i
End Function

=> Impedire_Taglia/Copia/Incolla
Autore : Tiziano Marmiroli

Private Sub Workbook_Open()
With Application
.CellDragAndDrop = False
.ExtendList = False
End With
Application.CommandBars("Cell").Enabled = False
Application.OnKey "^x", ""
Application.OnKey "^c", ""
Application.OnKey "^v", ""

For Each Ctrl In Application.CommandBars.FindControls(ID:=19)
Ctrl.Enabled = False
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=21)
Ctrl.Enabled = False
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=22)
Ctrl.Enabled = False
Next Ctrl
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
With Application
.CellDragAndDrop = True
.ExtendList = True
End With
Application.CommandBars("Cell").Enabled = True
Application.OnKey "^x"
Application.OnKey "^c"
Application.OnKey "^v"
Dim Ctrl As Office.CommandBarControl
For Each Ctrl In Application.CommandBars.FindControls(ID:=19)
Ctrl.Enabled = True
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=21)
Ctrl.Enabled = True
Next Ctrl
For Each Ctrl In Application.CommandBars.FindControls(ID:=22)
Ctrl.Enabled = True
Next Ctrl
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.CutCopyMode = False
End Sub