Le stringhe del profilo privato vengono spesso utilizzate per memorizzare informazioni specifiche dell'utente al di fuori dell'applicazione/documento per un uso successivo.
Potresti ad esempio memorizzare le informazioni sui contenuti più recenti in una finestra di dialogo/modulo utente,
quante volte è stata aperta una cartella di lavoro o l'ultimo numero di fattura utilizzato per un modello di fattura.
Le informazioni possono essere memorizzate in un file INI, sul disco rigido locale o in una cartella di rete condivisa.
Un file INI è un normale file di testo e il contenuto potrebbe essere simile a questo:
[PERSONALE]
Cognome=Doe
Nome=Giovanni
Data di nascita=1.1.1960
NumeroUnico=123456
Le stringhe del profilo privato per ciascun utente possono anche essere archiviate nel registro.
Excel non ha funzionalità integrate per leggere e scrivere su file INI come ha Word (System.PrivateProfileString),
quindi hai bisogno di un paio di funzioni API per farlo in modo semplice.
Ecco le macro di esempio per scrivere e leggere da un file INI contenente stringhe di profilo privato.
Const IniFileName As String = "C:\FolderName\UserInfo.ini"
'il percorso e il nome del file contenente le informazioni che vuoi leggere/scrivere
Private Declare Function GetPrivateProfileStringA Lib _ "Kernel32" (ByVal strSection As String, _ ByVal strKey As String, ByVal strDefault As String, _ ByVal strReturnedString As String, _ ByVal lngSize As Long, ByVal strFileName As String) As Long Private Declare Function WritePrivatePro _ "Kernel32" (ByVal strSection As String, _ ByVal strKey As String, ByVal strString As String, _ ByVal strFileNameName As String) As Long Private Function WritePrivateProfileString32(ByVal strFileName As String, _ ByVal strSection As String, ByVal strKey As String, _ ByVal strValue As String) As Boolean Dim lngValid As Long On Error Resume Next lngValid = WritePrivateProfileStringA(strSection, strKey, _ strValue, strFileName) If lngValid > 0 Then WritePrivateProfileString32 = True On Error GoTo 0 End Function Funzione privata GetStrPrivateProfileString32 , _ ByVal strSection As String, ByVal strKey As String, _ Optional strDefault) As String Dim strReturnStri ng As String, lngSize As Long, lngValid As Long On Error Resume Next If IsMissing(strDefault) Then strDefault = "" strReturnString = Space(1024) lngSize = Len(strReturnString) lngValid = GetPrivateProfileStringA(strSection, strKey, _ strDefault, strReturn lngSize, strFileName) GetPrivateProfileString32 = Left(strReturnString, lngValid) On Error GoTo 0 End Function ' gli esempi seguenti presumono che l'intervallo B3: B5 nel foglio attivo contenga ' informazioni su cognome, nome e data di nascita Sub WriteUserInfo() ' salva le informazioni in il file IniFileName If Not WritePrivateProfileString32(IniFileName, "PERSONAL", _ "Lastname", Range("B3").Value) Then MsgBox "Impossibile salvare le informazioni dell'utente in " & IniFileName, _ vbExclamation, "La cartella non esiste! " Exit Sub End If WritePrivateProfileString32 IniFileName, "PERSONAL", _ "Lastname", Range("B3").Value WritePrivateProfileString32 IniFileName, "PERSONAL", _ "Firstname", Range("B4").Value WritePrivateProfileString32 IniFileName, "PERSONAL" , _ "Birthdate", Range("B5").Value End Sub Sub ReadUserInfo() ' legge le informazioni dal file IniFileName If Dir(IniFileName) = "" Then Exit Sub Range("B3").Formula = GetPrivateProfileString32(IniFileName , _ "PERSONAL", "Lastname") Range("B4").Formula = GetPrivateProfileString32(IniFileName, _ "PERSONAL", "Firstname") Range("B5").Formula = GetPrivateProfileString32(IniFileName, _ "PERSONAL", "Data di nascita") End Sub ' l'esempio seguente presuppone che l'intervallo D4 nel foglio attivo contenga ' informazioni sul numero univoco Sub GetNewUniqueNumber() Dim UniqueNumber As Long If Dir(IniFileName) = "" Then Exit Sub UniqueNumber = 0 In caso di errore Riprendi successivo UniqueNumber = CLng(GetPrivateProfileString32(IniFileName, _ "PERSONAL", "UniqueNumber")) In caso di errore Vai a 0 Range("D4").Formula = UniqueNumber + 1 If Not WritePrivateProfileString32(IniFileName, "PERSONAL", _ "UniqueNumber", Range("D4").Value) Then MsgBox "Impossibile salvare le informazioni utente in " & IniFileName , _ vbExclamation, "La cartella non esiste!" Esci da Sub End If End Sub