Cordes Profil privé à l’aide de fichiers ini en utilisant VBA dans Microsoft Excel
Les chaînes de profil privé sont souvent utilisées pour stocker des informations spécifiques à l’utilisateur en dehors de l’application / du document pour une utilisation ultérieure.
Vous pouvez par exemple stocker des informations sur le dernier contenu dans une boîte de dialogue / formulaire utilisateur, combien de fois un classeur a été ouvert ou le dernier numéro de facture utilisé pour un modèle de facture.
Les informations peuvent être stockées dans un fichier INI, soit sur le disque dur local, soit dans un dossier réseau partagé.
Un fichier INI est un fichier texte ordinaire et le contenu pourrait ressembler à ceci:
Lastname = Doe Firstname = John Date de naissance = 1.1.1960 UniqueNumber = 123456 Les chaînes de profil privé pour chaque utilisateur peuvent également être stockées dans le registre.
Excel n’a pas de fonctionnalité intégrée pour lire et écrire dans des fichiers INI tels que Word a (System.PrivateProfileString), vous avez donc besoin de quelques fonctions API pour le faire de manière simple.
Voici les exemples de macros pour écrire et lire à partir d’un fichier INI contenant des chaînes de profil privé.
Const IniFileName As String = « C: \ FolderName \ UserInfo.ini »
‘le chemin et le nom du fichier contenant les informations que vous voulez lire / écrire
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 strFileNameName As String) As Long Private Declare Function WritePrivateProfileStringA Lib _ "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 Private Function GetPrivateProfileString32(ByVal strFileName As String, _ ByVal strSection As String, ByVal strKey As String, _ Optional strDefault) As String Dim strReturnString 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, strReturnString, lngSize, strFileName) GetPrivateProfileString32 = Left(strReturnString, lngValid) On Error GoTo 0 End Function ' the examples below assumes that the range B3:B5 in the active sheet contains ' information about Lastname, Firstname and Birthdate Sub WriteUserInfo() ' saves information in the file IniFileName If Not WritePrivateProfileString32(IniFileName, "PERSONAL", _ "Lastname", Range("B3").Value) Then MsgBox "Not able to save user info in " & IniFileName, _ vbExclamation, "Folder does not exist!" 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() ' reads information from the 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", "Birthdate") End Sub ' the example below assumes that the range D4 in the active sheet contains ' information about the unique number Sub GetNewUniqueNumber() Dim UniqueNumber As Long If Dir(IniFileName) = "" Then Exit Sub UniqueNumber = 0 On Error Resume Next UniqueNumber = CLng(GetPrivateProfileString32(IniFileName, _ "PERSONAL", "UniqueNumber")) On Error GoTo 0 Range("D4").Formula = UniqueNumber + 1 If Not WritePrivateProfileString32(IniFileName, "PERSONAL", _ "UniqueNumber", Range("D4").Value) Then MsgBox "Not able to save user info in " & IniFileName, _ vbExclamation, "Folder does not exist!" Exit Sub End If End Sub