Orson83
XLDnaute Impliqué
Bonjour à tous,
J'ai développé un fichier XL avec macros et je suis en phase de tests. Ce fichier fonctionne très bien chez moi avec mon XL 2010 (Windows seven 32 bits) mais je rencontre un problème chez un ami qui utilise XL 2013 (Windows 10 - 64 bits). En effet, son PC ne lit par correctement la macro ci-dessous qui se trouve dans le module MdlCM ((voir capture d'écran en PJ) :
PS : J'utilise ce code pour extraire un N° de disk dur, le récupérer et l'encoder.
Merci pour votre aide.
Tchotchodu31
J'ai développé un fichier XL avec macros et je suis en phase de tests. Ce fichier fonctionne très bien chez moi avec mon XL 2010 (Windows seven 32 bits) mais je rencontre un problème chez un ami qui utilise XL 2013 (Windows 10 - 64 bits). En effet, son PC ne lit par correctement la macro ci-dessous qui se trouve dans le module MdlCM ((voir capture d'écran en PJ) :
PS : J'utilise ce code pour extraire un N° de disk dur, le récupérer et l'encoder.
VB:
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function GetVolumeInformation& Lib "kernel32" Alias "GetVolumeInformationA" _
(ByVal lpRootPathName As String, ByVal pVolumeNameBuffer As String, ByVal nVolumeNameSize _
As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, ByVal lpFileSystemBuffer As String, _
ByVal nFileSystemNameSize As Long)
#Else
Private Declare Function GetVolumeInformation& Lib "kernel32" Alias "GetVolumeInformationA" _
(ByVal lpRootPathName As String, ByVal pVolumeNameBuffer As String, ByVal nVolumeNameSize _
As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, ByVal lpFileSystemBuffer As String, _
ByVal nFileSystemNameSize As Long)
#End If
Private Const MAX_FILENAME_LEN = 256
Public Function GetSerialNumber(sDrive As String)
#If VBA7 Then
Dim Serial As LongPtr
#Else
Dim Serial As Long
#End If
Dim Vname As String * MAX_FILENAME_LEN
Dim FSname As String * MAX_FILENAME_LEN
Application.Volatile
GetVolumeInformation sDrive + "\", Vname, MAX_FILENAME_LEN, Serial, 0, 0, FSname, MAX_FILENAME_LEN
GetSerialNumber = Serial
End Function
Function CalculPW(MotdePasse As String) As String
Dim ii As Integer
Dim Nb As Long
Dim N1 As Long
Dim Res As String
Res = ""
N1 = 255
For ii = 1 To Len(MotdePasse)
Nb = Asc(Mid$(MotdePasse, ii, 1))
Res = Res & Chr(Nb Xor N1)
Next ii
CalculPW = Res
End FunctionTchotchodu31