XL 2010 Incompatibilité VBA Windows 7 - 32 bits > Windows 10 - 64 bits

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.
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 Function
Merci pour votre aide.
Tchotchodu31
 

Pièces jointes

  • Message-alerte.png
    Message-alerte.png
    22.9 KB · Affichages: 42
Solution
bonjour essaie ca
VB:
#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 LongPtr, lpMaximumComponentLength As Long, _
  lpFileSystemFlags As Long, ByVal lpFileSystemBuffer As String, _
  ByVal nFileSystemNameSize As LongPtr)
#Else
mais pas convaincu
tu est sur d'injecter le disque corectement
exemple "C:\" et pas seulement C

patricktoulon

XLDnaute Barbatruc
bonjour essaie ca
VB:
#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 LongPtr, lpMaximumComponentLength As Long, _
  lpFileSystemFlags As Long, ByVal lpFileSystemBuffer As String, _
  ByVal nFileSystemNameSize As LongPtr)
#Else
mais pas convaincu
tu est sur d'injecter le disque corectement
exemple "C:\" et pas seulement C
 

Orson83

XLDnaute Impliqué
bonjour essaie ca
VB:
#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 LongPtr, lpMaximumComponentLength As Long, _
  lpFileSystemFlags As Long, ByVal lpFileSystemBuffer As String, _
  ByVal nFileSystemNameSize As LongPtr)
#Else
mais pas convaincu
tu est sur d'injecter le disque corectement
exemple "C:\" et pas seulement C
Bonsoir patricktoulon, le forum,
Merci pour cette correction de code. Pour répondre à ta question, l'idée est que le bout de code ci-dessous recherche le disk sur lequel est installé Windows (depuis un module) :
VB:
 Application.Volatile
  GetVolumeInformation sDrive + "\", Vname, MAX_FILENAME_LEN, Serial, 0, 0, FSname, MAX_FILENAME_LEN
  GetSerialNumber = Serial
...et que cette commande récupère le numéro également selon une recherche (depuis ThisWorkBook) :
Code:
CalculPXX(GetSerialNumber(Environ("homedrive")))
Je ne suis pas très calé en VBA, mais je pense que le code fonctionne de manière à automatiser la recherche du disk ou Windows est installé.
Tchotchodu31
 

Orson83

XLDnaute Impliqué
Bonsoir patricktoulon, le forum,
Merci pour cette correction de code. Pour répondre à ta question, l'idée est que le bout de code ci-dessous recherche le disk sur lequel est installé Windows (depuis un module) :
VB:
 Application.Volatile
  GetVolumeInformation sDrive + "\", Vname, MAX_FILENAME_LEN, Serial, 0, 0, FSname, MAX_FILENAME_LEN
  GetSerialNumber = Serial
...et que cette commande récupère le numéro également selon une recherche (depuis ThisWorkBook) :
Code:
CalculPXX(GetSerialNumber(Environ("homedrive")))
Je ne suis pas très calé en VBA, mais je pense que le code fonctionne de manière à automatiser la recherche du disk ou Windows est installé.
Tchotchodu31
Peut-être que le code pourrait être rendu plus compatible 32/64 bits en y intégrant quelques modifications selon 2 pages d'infos trouvées sur le Net ?
- Lien 1
- Lien 2
J'aurai bien mis les mains dans le cambouis mais j'ai peur d'en faire une machine à laver (qui ne lave plus :) ).
Si quelqu'un pouvait jeter un oeil ce serait sympa ;)
Tchotchodu31
 

Orson83

XLDnaute Impliqué
Bonsoir le fil

L'image n'est pas d'un grand secours
Un classeur exemple avec le code VBA serait d'une plus grande aide.
(Il se trouve que je suis sur Excel 2013 W10/64bits)
Il manque CalculPXX
(Sauf si CalculPXX correspond à CalculPW)
Bonsoir Staple, le forum,
Bien vu Staple, c'est bien CalculPW, mais j'ai bien fait des tests avec CalculPW sur mon 32 bits mais effectivement, c'est le 64 bits qui pose problème.
Je te donnerai bien l'intégralité du code mais je tiens à le garder confidentiel car c'est la protection de mon classeur, désolé (à moins que je puisse le faire d'une autre manière ?).
Je cherche juste à savoir si la partie du code ci-dessous peut être améliorée pour que la macro soit lue correctement sur Windows 32 et 64 bits :
VB:
#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
Sachant que patricktoulon l'a déjà améliorée (post #2) mais il n'est pas convaincu.
Merci du coup de main.
Tchotchodu31
 

Staple1600

XLDnaute Barbatruc
Re

[paradoxe ou incongruité, un soir d'hiver]
Tu te décris comme débutant en VBA.
Les différents bouts de code qui t'ont été proposés par les membres du forum dans tes différentes discussions le furent "en clair" et comme le dit l'adage XLDien "pour le partage des connaissances autour d'Excel"
J'ai donc du mal à voir où se situe le confidentiel ici ?
D'autant plus que ton classeur est déjà sur le PC d'un tiers.
[/paradoxe ou incongruité, un soir d'hiver]

*l'intégralité du code est bien plus ou mois constitué des procédures déposées dans tes fils par nos camarades de jeux, non ?
• Enregistrer/Enregistrer Sous en .xlsm Nom et emplacement libre
• Décryptage / cryptage numéro de disque dur
• Macro pour mot de passe à l'ouverture d'Excel
etc...

NB: Et comme tu le sais déjà, Excel permet d'ouvrir un classeur sans ouvrir les macros (donc confidentialité toute relative)

Mais ce n'est pas grave, mon Excel 2013 sur W10/64bits servira à tester du code VBA non confidentiel dans d'autres fils. ;)
 

Orson83

XLDnaute Impliqué
Re

[paradoxe ou incongruité, un soir d'hiver]
Tu te décris comme débutant en VBA.
Les différents bouts de code qui t'ont été proposés par les membres du forum dans tes différentes discussions le furent "en clair" et comme le dit l'adage XLDien "pour le partage des connaissances autour d'Excel"
J'ai donc du mal à voir où se situe le confidentiel ici ?
D'autant plus que ton classeur est déjà sur le PC d'un tiers.
[/paradoxe ou incongruité, un soir d'hiver]

*l'intégralité du code est bien plus ou mois constitué des procédures déposées dans tes fils par nos camarades de jeux, non ?
• Enregistrer/Enregistrer Sous en .xlsm Nom et emplacement libre
• Décryptage / cryptage numéro de disque dur
• Macro pour mot de passe à l'ouverture d'Excel
etc...

NB: Et comme tu le sais déjà, Excel permet d'ouvrir un classeur sans ouvrir les macros (donc confidentialité toute relative)

Mais ce n'est pas grave, mon Excel 2013 sur W10/64bits servira à tester du code VBA non confidentiel dans d'autres fils. ;)
Libre à toi Staple... Je ne me proclame pas comme étant l'auteur de ce code, je cherche juste à l'améliorer grâce au forum pour le rendre compatible (ça peut aussi servir aux autres visiteurs).
Tu remarqueras que le sujet ne porte pas sur le résultat obtenu par un outil, mais sur :

"Incompatibilité VBA Windows 7 - 32 bits > Windows 10 - 64 bits"​

je n'invente rien, c'est le titre ! Désolé de t'avoir vexé, ce n'était pas le but ;)
Donc sujet non résolu....
Bonne soirée.
Tchotchodu31
 

Staple1600

XLDnaute Barbatruc
Re

Tu te méprends.
Il fallait juste retenir de mon message, ceci:
Avec juste une image et des bribes de code, je ne vois pas trop comment on pourrait faire des tests fiables sur nos PC.

Et sinon un petit clin d'oeil pour finir ;)
I'am not mais un peu quand même à dit:
J'ai développé un fichier XL avec macros et je suis en phase de tests

NB: on remarquera que le message est rédigé en mode ironico-humoristique (mais indolore et aseptisé à cause du masque ;))
 

Orson83

XLDnaute Impliqué
Re

Tu te méprends.
Il fallait juste retenir de mon message, ceci:
Avec juste une image et des bribes de code, je ne vois pas trop comment on pourrait faire des tests fiables sur nos PC.

Et sinon un petit clin d'oeil pour finir ;)


NB: on remarquera que le message est rédigé en mode ironico-humoristique (mais indolore et aseptisé à cause du masque ;))
Ok, la prochaine fois je dirais "Avec l'aide des participants de ce forum" méa culpa.
Toujours est-il que je ne comprends pas ton acharnement à scruter le moindre mot qui serait dit de travers.
Je n'arrive pas à comprendre si tu cherches à aider ou à faire la police.
Je laisse tomber, cette discussion devient malsaine. Bravo, je passe ce sujet en résolu.
Merci aux participants de ce fil pour leur aide.
Bonne soirée.
 

Staple1600

XLDnaute Barbatruc
Re

:eek:
Euh, je faisais juste de l'humour...

Et pour la question:
C'est pourtant clair, sans voir le projet VBA (et sans connaitre les imbrications entre les diverses procédures), on ne peut qu'émettre des hypothèses.

PS: j'ai pourtant pris le soin de mettre un NB dans le précédent message qui précisait les choses, non ?
Je suis rassuré de voir qu'au moins patricktoulon l'a vu. ;)
 

patricktoulon

XLDnaute Barbatruc
re
VB:
Sub test()
    Dim oFSO, oDrv
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    oDrv = Left(Environ("SystemDrive"), 1)
    Set oDrv = oFSO.GetDrive(oDrv)
    MsgBox "mondisque d'exploitation " & vbCrLf & _
    "DriveLetter     : " & oDrv.DriveLetter & vbCrLf & _
           "DriveType       : " & oDrv.drivetype & vbCrLf & _
           "FileSystem      : " & oDrv.FileSystem & vbCrLf & _
           "AvailableSpace  : " & oDrv.AvailableSpace & vbCrLf & _
           "FreeSpace       : " & oDrv.FreeSpace & vbCrLf & _
           "IsReady         : " & oDrv.IsReady & vbCrLf & _
           "Path            : " & oDrv.Path & vbCrLf & _
           "RootFolder      : " & oDrv.RootFolder & vbCrLf & _
           "SerialNumber    : " & oDrv.SerialNumber & vbCrLf & _
           "ShareName       : " & oDrv.ShareName & vbCrLf & _
           "VolumeName      : " & oDrv.VolumeName & vbCrLf & _
           "TotalSize       : " & oDrv.TotalSize
End Sub
Sub test2()
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Each Drv In FSO.Drives
        If Drv.IsReady Then
            texte = texte & vbCrLf & "le support " & Drv.DriveLetter & vbCrLf & "drivetype : " & Drv.drivetype & vbCrLf & "Numero de serie : " & Drv.SerialNumber & vbCrLf & "espace disponible : :" & Drv.FreeSpace & " octets"
            texte = texte & vbCrLf & "****************************"
        End If
    Next
    MsgBox texte
End Sub

pour les api tu reviens à l'hapy hour hein ;)
 

Staple1600

XLDnaute Barbatruc
Re

Et là aussi, tant pis pour les MACistes ;)
VB:
Sub test()
Dim NoPasaran$
NoPasaran = GetMACAddress
MsgBox NoPasaran
End Sub
Private Function GetMACAddress(Optional PrivacyWasNotWas) As String
Dim sComputer$, myMacAddress$, oWMIService As Object, cItems As Object, oItem As Object
sComputer = "."
Set oWMIService = GetObject("winmgmts:\\" & sComputer & "\root\cimv2")
Set cItems = oWMIService.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
For Each oItem In cItems
        If Not IsNull(oItem.IPAddress) Then myMacAddress = oItem.macAddress
        Exit For
    Next
GetMACAddress = myMacAddress
End Function

NB: En théorie, on change plus souvent de disque dur que de carte réseau ;)
Mais si on change de PC, le classeur ne fonctionnera plus.
(Heureusement que...)
 

Staple1600

XLDnaute Barbatruc
Re

Précisions:
le code de mon message précédent a été donc été testé sur un W10/64bits et Excel 2013.
Devrait normalement fonctionner sur W7 et XL 32 bits
(mais comme indiqué ne fonctionnera pas sur un Mac)

NB: Faudrait tester aussi sur un PC avec plusieurs cartes réseau.
 

Discussions similaires

Statistiques des forums

Discussions
314 717
Messages
2 112 169
Membres
111 449
dernier inscrit
jhugot