|
| HOMEPAGE | INDICE FORUM | REGOLAMENTO | ::. | NEI PREFERITI | .:: | RSS Forum | RSS News | NEWS web | NEWS software | |
| PUBBLICITA' | | | ARTICOLI | WIN XP | VISTA | WIN 7 | REGISTRI | SOFTWARE | MANUALI | RECENSIONI | LINUX | HUMOR | HARDWARE | DOWNLOAD | | | CERCA nel FORUM » | |
28-06-2014, 21.03.30 | #46 |
Senior Member
WT Expert
Registrato: 19-05-2007
Loc.: Verona
Messaggi: 1.302
|
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:
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 Codice:
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 Fig. 1 Codice:
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 Codice:
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 Codice:
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 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 Codice:
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 Fig. 2 Codice:
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 Codice:
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 Codice:
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 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:
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. Codice:
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 Codice:
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
___________________________________
- Il primo fondamento della sicurezza non e' la tecnologia, ma l'attitudine mentale - |
13-07-2014, 17.02.00 | #47 |
Senior Member
WT Expert
Registrato: 19-05-2007
Loc.: Verona
Messaggi: 1.302
|
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: Codice:
oFSO = CreateObject("Scripting.FileSystemObject") Codice:
Dim oFSO As New FileSystemObject 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 Codice:
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 Codice:
Sub info1() Dim infoF As String infoF = "C:\Test\info1.txt" FileInfo (infoF) End Sub Codice:
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 Codice:
Sub info2() Dim infoC As String infoC = "C:\Test" FolderInfo (infoC) End Sub Codice:
Function FolderE(DirName As String) As Boolean On Error Resume Next FolderE = GetAttr(DirName) And vbDirectory End Function Codice:
Sub Prova1() Dim Percorso As String Percorso = "C:\Test" MsgBox FolderE(Percorso) End Sub Codice:
Function FileE(FileName As String) As Boolean On Error Resume Next FileE = GetAttr(FileName) And vbArchive End Function Codice:
Sub Prova2() Dim FileN As String FileN = "C:\Test\info1.txt" MsgBox FileE(FileN) End Sub 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. Codice:
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 Codice:
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 Codice:
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
Codice:
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 Codice:
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 Codice:
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 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:
Codice:
Dim oFSO As Scripting.FileSystemObject Dim oFld As Folder Set oFSO = New Scripting.FileSystemObject Set oFld = oFSO.GetFolder("C:\Windows") Codice:
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 Codice:
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 Codice:
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") Codice:
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
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 Codice:
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
Codice:
If oFld.Attributes And Directory Then MsgBox "Nascosto" If oFld.Attributes And (Hidden + ReadOnly) Then MsgBox "Nascosta e di sola lettura" Codice:
If oFld.Attributes And Hidden Then oFld.Attributes = oFld.Attributes - Hidden End If
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:
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.
Codice:
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 Codice:
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 Codice:
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
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. Codice:
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
___________________________________
- Il primo fondamento della sicurezza non e' la tecnologia, ma l'attitudine mentale - |
14-07-2014, 20.36.49 | #48 |
Senior Member
WT Expert
Registrato: 19-05-2007
Loc.: Verona
Messaggi: 1.302
|
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: Codice:
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 Codice:
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 Codice:
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 Codice:
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 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:
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 Codice:
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 Codice:
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 Codice:
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 Codice:
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 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 Codice:
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 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 Codice:
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
___________________________________
- Il primo fondamento della sicurezza non e' la tecnologia, ma l'attitudine mentale - |
27-07-2014, 09.10.43 | #49 |
Senior Member
WT Expert
Registrato: 19-05-2007
Loc.: Verona
Messaggi: 1.302
|
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 Codice:
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 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: Codice:
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 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 Codice:
With cdoMess .To = Eto .From = Efrom .Subject = Eogg .TextBody = Emess .AddAttachment "C:\Test\info.txt" .Send End With 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: Codice:
'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 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 '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 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") '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
___________________________________
- Il primo fondamento della sicurezza non e' la tecnologia, ma l'attitudine mentale - |
27-07-2014, 09.14.36 | #50 |
Senior Member
WT Expert
Registrato: 19-05-2007
Loc.: Verona
Messaggi: 1.302
|
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 Codice:
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 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 Codice:
Sub ultima_3() Dim ultimaC As Integer ultimaC = ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column MsgBox ultimaC End Sub 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. Codice:
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 Codice:
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 Codice:
Sub prova_RU() Dim rigaU As Long rigaU = ActiveSheet.UsedRange.Rows.Count MsgBox rigaU End Sub Codice:
Sub prova_CU() Dim colonnaU As Integer colonnaU = ActiveSheet.UsedRange.Columns.Count MsgBox colonnaU End Sub Codice:
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 Codice:
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 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 Codice:
Sub ultimaR1() Dim ultimaR As Long ultimaR = ActiveSheet.Range("D2").End(xlDown).Row MsgBox ultimaR End Sub Codice:
Sub ultima8() Dim ultimaC As Integer ultimaC = ActiveSheet.Range("C4").End(xlToRight).Column MsgBox ultimaC End Sub Fig. 1 Codice:
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 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”) Codice:
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 Codice:
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 Codice:
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 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
Il Metodo SpecialCells per trovare l’ultima colonna Codice:
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
___________________________________
- Il primo fondamento della sicurezza non e' la tecnologia, ma l'attitudine mentale - |
27-07-2014, 09.15.48 | #51 |
Senior Member
WT Expert
Registrato: 19-05-2007
Loc.: Verona
Messaggi: 1.302
|
#2
Convertire testo in maiuscolo e cambiare colore al carattere alle celle che contengono formule, formule e numeri e costanti
Convertire qualsiasi immissione in maiuscolo (testo o formula) Codice:
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Then 'Questo controllo impedisce di ripetere la procedura If Not Target.Text = UCase(Target.Text) Then If Target.HasFormula = True Then Target.Formula = "=UPPER(" & Mid(Target.Formula, 2) & ")" 'Mid(Target.Formula, 2) elimina “=” dalla formula Else Target = UCase(Target.Text) End If End If End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) With Target If .Column = 1 Then 'Questo controllo impedisce di ripetere la procedura If .Value <> UCase(.Value) Then If .HasFormula = True Then .Formula = "=UPPER(" & Right(.Formula, Len(.Formula) - 1) & ")" 'in alternative si può usare: '.Formula = "=UPPER(" & Mid(.Formula, 2) & ")" ‘per eliminare “=” dalla formula 'Right(.Formula, Len(.Formula) - 1) 'Mid(Target.Formula, 2 Else .Value = UCase(.Value) End If End If End If End With End Sub Private Sub Worksheet_Change(ByVal Target As Range) With Target If Not Application.Intersect(Target, Range("A1:C10")) Is Nothing Then 'Questo controllo impedisce di ripetere la procedura If .Value <> UCase(.Value) Then If .HasFormula = True Then .Formula = "=UPPER(" & Right(.Formula, Len(.Formula) - 1) & ")" 'in alternative si può usare: .Formula = "=UPPER(" & Mid(.Formula, 2) & ")" ‘per eliminare “=” dalla formula 'Right(.Formula, Len(.Formula) - 1) 'Mid(Target.Formula, 2 Else .Value = UCase(.Value) End If End If End If End With End Sub Sub Maiuscolo() Dim Cell As Range For Each Cell In Selection.Cells If Not Cell.HasFormula Then 'In alternativa: "If Cell.HasFormula = False Then" Cell = UCase(Cell) End If Next End Sub Cambiare colore al carattere nelle celle contenenti formule, formule e numeri e costanti Codice:
Sub Colore1() Dim Col_F As Long, Col_FN As Long, Col_C As Long, cell As Range Col_F = RGB(Red:=0, Green:=255, Blue:=0) Col_FN = RGB(Red:=0, Green:=0, Blue:=0) Col_C = RGB(Red:=0, Green:=0, Blue:=255) 'imposta il colore alle celle che contengono formule For Each cell In ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas) cell.Font.Color = Col_F Next cell 'imposta il colore alle celle che contengono formule e numeri For Each cell In ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas, xlNumbers) Next cell 'imposta il colore alle celle che contengono costanti (non formule) For Each cell In ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants) cell.Font.Color = Col_C Next cell End Sub Sub Colore2() Dim Col_F As Long, Col_FN As Long, Col_C As Long, cell As Range Col_F = RGB(Red:=0, Green:=255, Blue:=0) Col_FN = RGB(Red:=0, Green:=0, Blue:=0) Col_C = RGB(Red:=0, Green:=0, Blue:=255) For Each cell In ActiveSheet.UsedRange 'imposta il colore alle celle che contengono formule If cell.HasFormula = True Then cell.Font.Color = Col_F 'imposta il colore alle celle che contengono formule e numeri If IsNumeric(cell) = True Then cell.Font.Color = Col_FN End If Else 'imposta il colore alle celle che contengono costanti (non formule) cell.Font.Color = Col_C End If Next cell End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim Col_F As Long, Col_FN As Long, Col_C As Long Col_F = RGB(Red:=0, Green:=255, Blue:=0) Col_FN = RGB(Red:=0, Green:=0, Blue:=0) Col_C = RGB(Red:=0, Green:=0, Blue:=255) With Target 'imposta il colore alle celle che contengono formule If .HasFormula Then .Font.Color = Col_F 'imposta il colore alle celle che contengono formule e numeri If IsNumeric(Target) Then .Font.Color = Col_FN End If 'imposta il colore alle celle che contengono costanti (non formule) Else .Font.Color = Col_C End If End With End Sub
___________________________________
- Il primo fondamento della sicurezza non e' la tecnologia, ma l'attitudine mentale - |
30-07-2014, 09.54.15 | #52 |
Senior Member
WT Expert
Registrato: 19-05-2007
Loc.: Verona
Messaggi: 1.302
|
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:
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:
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. Codice:
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 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. Codice:
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 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 Codice:
ListView1.listItems(1).listSubItems(2).Text = "Prova" Codice:
ListView1.ListItems(3).Text = "prova Modifica" Codice:
ListView1.labeledit = 1 Codice:
MsgBox ListView1.ListItems("A1").Text Codice:
MsgBox ListView1.ListItems("A1").ListSubItems("A2").Text Codice:
MsgBox ListView1.ListItems(2).Key Codice:
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 Codice:
'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) Codice:
ListView1.ListItems.Clear Codice:
ListView1.listitems(1).ListSubItems(2).ForeColor = RGB(100, 0, 100) Codice:
ListView1.ListItems(2).ListSubItems.Add , , Format(1234567.89, "##,##0.00") Codice:
ListView1.FullRowSelect = True Codice:
ListView1.Gridlines = True Codice:
Me.ListView1.CheckBoxes = True Codice:
Dim i As Integer For i = 1 To ListView1.ListItems.Count ListView1.ListItems(i).Checked = False Next i Codice:
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 Codice:
ListView1.HideColumnHeaders = True Codice:
ListView1.ColumnHeaders.Add , , "Città", 50, lvwColumnCenter Codice:
ListView1.AllowColumnReorder = True
___________________________________
- Il primo fondamento della sicurezza non e' la tecnologia, ma l'attitudine mentale - |
24-08-2014, 09.21.29 | #53 |
Senior Member
WT Expert
Registrato: 19-05-2007
Loc.: Verona
Messaggi: 1.302
|
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:
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 Codice:
Private Sub Text1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If InStr("1234567890,-", Chr(KeyAscii)) = 0 Then KeyAscii = 0 End sub
Codice:
Private Sub Text1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If InStr("1234567890,-", Chr(KeyAscii)) = 0 Then KeyAscii = 0 : Beep End sub Codice:
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
Codice:
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
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 Codice:
FunOK If (stringa1) = True Then Cancel = True: Text1.Value = " "Beep: MsgBox" Input non valido " Codice:
If stringa1 = "" Then Exit Function Codice:
If Len(Replace(stringa1, ".", "")) <> Len(stringa1) Then FunOK = True: Exit Function Codice:
If Len(stringa1) = 1 And InStr("1234567890", stringa1) = 0 Then FunOK = True: Exit Function Codice:
stringa1 = Replace(stringa1, ",", ".") Codice:
If Len(CStr(Val(stringa1))) <> Len(stringa1) Then FunOK = True Codice:
Private Sub command1_Click() Cells(5, 1) = Text1.Value End Sub 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: Codice:
Private Sub scrivi1_Click() Cells(5, 3) = CDbl(Text1.Value) End Sub Fig. 3 Possiamo completare il codice per raggiungere i due tipi di dati da scrivere nella cella e vederne i risultati in questo modo: Codice:
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 Codice:
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
___________________________________
- Il primo fondamento della sicurezza non e' la tecnologia, ma l'attitudine mentale - |
08-09-2014, 00.18.30 | #54 |
Senior Member
WT Expert
Registrato: 19-05-2007
Loc.: Verona
Messaggi: 1.302
|
#1
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 Codice:
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 Nota: Questa routine riporta il valore presente nell’ultima riga contenente dati della colonna A Codice:
Sub trova1() ultima = [A1].End(xlDown) MsgBox ultima End Sub Nota: Alcune routine che scorrono la colonna A e cancellano le righe vuote Codice:
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 Nota: Inserendo il numero delle righe separato dalla virgola vengono cancellate le righe scelte Codice:
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 Codice:
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 Codice:
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 Codice:
Sub Blocca_riga() Rows("2:2").Select ActiveWindow.FreezePanes = True End Sub Codice:
Sub seleziona() Range(ActiveCell.Address & ":" & ActiveCell.End(xlToRight).Address).Select End Sub Codice:
Sub riga1() riga = ActiveCell.Row MsgBox riga End Sub Codice:
Sub conta_righe() [A1].Select ActiveCell.CurrentRegion.Select conta = Selection.count MsgBox "La selezione contiene " & Selection.Rows.count & " righe" End Sub Codice:
Sub InserireS() ActiveCell(2).Resize(1).EntireRow.Insert End Sub Codice:
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
___________________________________
- Il primo fondamento della sicurezza non e' la tecnologia, ma l'attitudine mentale - |
08-09-2014, 00.19.24 | #55 |
Senior Member
WT Expert
Registrato: 19-05-2007
Loc.: Verona
Messaggi: 1.302
|
#2
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. Codice:
Sub nascondiC() Dim foglio As Worksheet col = InputBox("Quale colonna vuoi nascondere ?") col2 = col & ":" & col Columns(col2).Select Selection.EntireColumn.Hidden = True End Sub Nota: Viene riportata la lettera della colonna in base al valore numerico della variabile lettera Codice:
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 Nota: Funzione per conoscere la lettera della colonna della cella attiva Codice:
Function letteraCol(cell As Range) letteraCol = Left$(cell.Address(0, 0), (cell.Column < 27) + 2) End Function Sub test() MsgBox letteraCol(ActiveCell) End Sub 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 Codice:
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
___________________________________
- Il primo fondamento della sicurezza non e' la tecnologia, ma l'attitudine mentale - |
08-09-2014, 00.20.15 | #56 |
Senior Member
WT Expert
Registrato: 19-05-2007
Loc.: Verona
Messaggi: 1.302
|
#3
Macro e Procedure varie riferite alle Celle
=> Trovare la prima cella vuota Codice:
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 Codice:
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 Nota: Aggiunge il testo presente in una cella alle celle dell’intervallo Codice:
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 Nota: Inserire nella finestrella di Input l’intervallo da selezionare, digita ad esempio C3:E10 oppure A1:C10,J9:J12 Codice:
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 Codice:
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 Codice:
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$10" Then pippo End Sub Codice:
ActiveCell.HorizontalAlignment = xlRight ' a destra ActiveCell.HorizontalAlignment = xlLeft ' a sinistra ActiveCell.HorizontalAlignment = xlCenter ' al centro 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 Codice:
Worksheets("Foglio1").Range("C3").Formula=("=SUM(A1:A10)") 'oppure Worksheets("Foglio2").Range("C3").FormulaLocal=("=SOMMA(A1:A10)") Codice:
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 Codice:
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 Nota : Metodo per convertire la prima lettera di una frase in maiuscolo Codice:
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
___________________________________
- Il primo fondamento della sicurezza non e' la tecnologia, ma l'attitudine mentale - |
08-09-2014, 00.21.49 | #57 |
Senior Member
WT Expert
Registrato: 19-05-2007
Loc.: Verona
Messaggi: 1.302
|
#4
Macro e Procedure varie riferite al foglio di lavoro
=> Mostra tutti i fogli della cartella aperta Codice:
Sub ScorreFogli() For i = 1 To Worksheets.Count With Worksheets(i) .Activate MsgBox .Name End With Next End Sub Codice:
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 Codice:
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 Codice:
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 Nota: Riporta il valore True se il foglio esiste oppure False per il contrario Codice:
Sub test() MsgBox foglioE("fogliol1") End Sub Function foglioE(Nom$) As Boolean On Error Resume Next foglioE = Sheets(Nom).Name <> "" Err.Clear End Function Codice:
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 Codice:
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 Codice:
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 Nota: Viene mostrata la finestra di scelta dei file per Inserire un’immagine come sfondo nel commento Codice:
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 Nota : Permette di copiare il formato di un foglio in un altro foglio. Copia soltanto il formato. Codice:
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 Codice:
Sub foglioS() ActiveSheet.Next.Select End Sub Sub foglioP() ActiveSheet.Previous.Select End Sub Nota: L'esempio seguente verifica, mentre si sta inserendo un nome oppure un numero, se quest'ultimo sia gia' stato inserito: Autore: Microsoft Codice:
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
___________________________________
- Il primo fondamento della sicurezza non e' la tecnologia, ma l'attitudine mentale - |
08-09-2014, 00.22.38 | #58 |
Senior Member
WT Expert
Registrato: 19-05-2007
Loc.: Verona
Messaggi: 1.302
|
#5
Macro e Procedure varie riferite alle Userform
=> Link email in una Userform Codice:
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 Codice:
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 Codice:
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. Codice:
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 Codice:
sub Form_V() If UserForm1.Visible = True Then MsgBox "Buongiormo" 'Macro1 Else MsgBox "Arrivederci" 'Macro2 End If end sub Codice:
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 Codice:
ListBox1.Font.Name = "Calibri" ListBox1.Font.Italic = True ListBox1.Font.Size = 12 Nota: Copiare il codice nel Workbook in cui volete ridurre la finestra, così all'apertura, la finestra sarà sempre piccola. Autore: Marco Gamberini Codice:
Private Sub Workbook_BeforeClose(Cancel As Boolean) ActiveWindow.WindowState = xlMaximized End Sub Private Sub Workbook_Open() ActiveWindow.WindowState = xlMinimized End Sub Nota: Una macro per visualizzare una Userfom, senza vedere Excel. Autore N. Jones Codice:
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 Nota : Permette di imporre dove fare comparire un userform e di non potere spostarlo Codice:
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 Commento : Permette di postare la Userform su un lato dello schermo Autore: M. Pierron Codice:
Sub Visalizza() With UserForm1 .StartUpPosition = 0 .Left = Application.UsableWidth - .Width .Top = Application.UsableHeight - .Height .Show End With End Sub Commento : Permette, dopo avere creato un oggetto label, di fare sfilare un testo sull'userform Autore : Hervé Codice:
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 Codice:
'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")
___________________________________
- Il primo fondamento della sicurezza non e' la tecnologia, ma l'attitudine mentale - |
08-09-2014, 00.23.31 | #59 |
Senior Member
WT Expert
Registrato: 19-05-2007
Loc.: Verona
Messaggi: 1.302
|
#6
Macro e Procedure varie riferite ai File
=> Crea un file txt Codice:
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 Codice:
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 Codice:
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 Nota: Attenzione, questa macro distrugge il file per sempre Codice:
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 Codice:
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 Nota: Ritorna tutte le proprietà della cartella attiva. Codice:
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 Codice:
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
___________________________________
- Il primo fondamento della sicurezza non e' la tecnologia, ma l'attitudine mentale - |
08-09-2014, 00.24.16 | #60 |
Senior Member
WT Expert
Registrato: 19-05-2007
Loc.: Verona
Messaggi: 1.302
|
#7
Macro e Procedure varie
=> Annullare ogni azione - Undo in VBA Codice:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Application.EnableEvents = False Application.Undo Application.EnableEvents = True End Sub Codice:
Private Sub Workbook_Activate() For i = 1 To 250 On Error Resume Next Application.OnKey Chr(i), "Macro1" Next i End Sub Codice:
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 Codice:
Sub IncVal() Selection.Copy Selection.PasteSpecial Paste:=xlValues Application.CutCopyMode = False If ActiveCell.Text = "#N/D" Then ActiveCell = "" End Sub Nota: Ordinare i dati in base al valore presente nella cella D2 Codice:
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 Nota: Una macro che viene eseguita ad un’ora precisa, usando la funzione Ontime. Codice:
Private Sub Workbook_Open() Application.OnTime TimeValue("22:00:00"), "Macro1" End Sub Codice:
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address = "$A$1" Then MsgBox "forza !" 'Macro1 End Sub Codice:
Sub giornoedata() Dim x As Date x = Date [B2] = Format(x, "dddd") & Space(2) & "-" & Space(2) & x End Sub Codice:
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 Codice:
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 Codice:
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$3" Then pippo End Sub Codice:
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 Nota : Toglie tutti gli apostrofi nelle celle Codice:
Sub app1() For Each cell In ActiveSheet.UsedRange If cell.PrefixCharacter <> "" Then cell.Formula = cell.Formula End If Next cell End Sub Nota : Questa funzione cambia i caratteri vietati per il nome del file, con il carattere "_". Codice:
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 Codice:
Sub senzaM() ThisWorkbook.Sheets.Copy ActiveWorkbook.SaveAs MyNewPathAndFile ThisWorkbook.Close False End Sub Codice:
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 Autore : Tiziano Marmiroli Codice:
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
___________________________________
- Il primo fondamento della sicurezza non e' la tecnologia, ma l'attitudine mentale - |
Utenti attualmente attivi che stanno leggendo questa discussione: 2 (0 utenti e 2 ospiti) | |
Strumenti discussione | |
|
|
Discussioni simili | ||||
Discussione | Autore discussione | Forum | Risposte | Ultimo messaggio |
riserca del corso | rene' | Software applicativo | 1 | 04-04-2008 10.30.22 |
Formare Gruppo di Studio a Napoli | Scognamiglio | Windows 7/Vista/XP/ 2003 | 0 | 14-02-2008 20.46.49 |
Corso su DVD di Tedesco | Downloader | Chiacchiere in libertà | 17 | 26-01-2007 08.46.21 |
Win XP e corso di inglese che non va più | Raboso | Windows 7/Vista/XP/ 2003 | 8 | 11-11-2005 10.16.04 |
svendo corso Cisco | alxdvc | Internet e Reti locali | 0 | 27-01-2005 12.03.45 |