Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Microsoft Office Discussion :

Adapter un code 32 bits en 64 bits


Sujet :

Microsoft Office

  1. #1
    Membre à l'essai
    Adapter un code 32 bits en 64 bits
    Bonjour tout le monde,

    J'ai de nouveau besoin de vos compétences.

    J'ai le code suivant qui détecte l'usurname et le numéro de serie du DD à l'ouverture du fichier excel :

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    Private Declare Function GetVolumeInformation Lib _
    "Kernel32.dll" Alias "GetVolumeInformationA" (ByVal _
    lpRootPathName As String, ByVal lpVolumeNameBuffer As _
    String, ByVal nVolumeNameSize As Integer, _
    lpVolumeSerialNumber As Long, _
    lpMaximumComponentLength _
    As Long, lpFileSystemFlags As Long, ByVal _
    lpFileSystemNameBuffer As String, ByVal _
    nFileSystemNameSize As Long) As Long
     
    Function NumSerieDD(LettreDD As String) As Long
    Dim SerialNum As Long
    Dim R As Long
    Dim Temp1 As String
    Dim Temp2 As String
    LettreDD = LettreDD & ":\"
    Temp1 = String$(255, Chr$(0))
    Temp2 = String$(255, Chr$(0))
    R = GetVolumeInformation(LettreDD, Temp1, _
    Len(Temp1), SerialNum, 0, 0, Temp2, Len(Temp2))
    NumSerieDD = SerialNum
    End Function


    Il fonctionne très bien en 32bits. Je crois qu'il faut ajouter des "PtrSafe" pour qu'il fonctionne en 64 bits.

    J'ai besoin que le code fonctionne sur 32 comme 64 bits.

    Est ce que quelqu'un peut me l'adapter s'il vous plait.

    Merci d'avance.

  2. #2
    Membre à l'essai
    Adapter un code 32 bits en 64 bits
    Bonjour tout le monde et merci pour vos réponses.

    Je me suis lancé dans l'adaptation du code.

    Pouvez-vous me donnez votre avis?

    Il fonctionne sur excel 32 bits. Est ce que quelqu'un peu faire un test sur excel 64 bits pour me dire si il fonctionne ?

    Je n'ai pas d'excel 64 bits à la maison.

    Se serait super sympa

    Merci d'avance

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
     
    Option Explicit
     
    #If VBA7 Then
    Private Declare PtrSafe Function GetVolumeInformation Lib _
    "Kernel32.dll" Alias "GetVolumeInformationA" (ByVal _
    lpRootPathName As String, ByVal lpVolumeNameBuffer As _
    String, ByVal nVolumeNameSize As Integer, _
    lpVolumeSerialNumber As LongPtr, _
    lpMaximumComponentLength _
    As LongPtr, lpFileSystemFlags As LongPtr, ByVal _
    lpFileSystemNameBuffer As String, ByVal _
    nFileSystemNameSize As LongPtr) As LongPtr
     
    #Else
    Private Declare Function GetVolumeInformation Lib _
    "Kernel32.dll" Alias "GetVolumeInformationA" (ByVal _
    lpRootPathName As String, ByVal lpVolumeNameBuffer As _
    String, ByVal nVolumeNameSize As Integer, _
    lpVolumeSerialNumber As Long, _
    lpMaximumComponentLength _
    As Long, lpFileSystemFlags As Long, ByVal _
    lpFileSystemNameBuffer As String, ByVal _
    nFileSystemNameSize As Long) As Long
    #End If
     
    Function NumSerieDD(LettreDD As String) As LongPtr
    Dim SerialNum As LongPtr
    Dim R As LongPtr
    Dim Temp1 As String
    Dim Temp2 As String
    LettreDD = LettreDD & ":\"
    Temp1 = String$(255, Chr$(0))
    Temp2 = String$(255, Chr$(0))
    R = GetVolumeInformation(LettreDD, Temp1, _
    Len(Temp1), SerialNum, 0, 0, Temp2, Len(Temp2))
    NumSerieDD = SerialNum
    End Function
     
     
     
    Sub Test_Info()
    Range("D3") = Environ("Username")
    Range("D4") = NumSerieDD("C")
    End Sub