Function VersionExcelComplete() As String
Dim reg As Object, key As String, value As String
Dim versionNum As Long, arch As String, v As Double
Dim names As Variant, types As Variant, i As Long
' Architecture
#If VBA7 Then
#If Win64 Then
arch = "64 bits"
#Else
arch = "32 bits"
#End If
#Else
arch = "32 bits"
#End If
' Anciennes versions
v = Val(Application.Version)
Select Case v
Case 12: VersionExcelComplete = "2007 - " & arch: Exit Function
Case 14: VersionExcelComplete = "2010 - " & arch: Exit Function
Case 15: VersionExcelComplete = "2013 - " & arch: Exit Function
Case Is < 12: VersionExcelComplete = "Version trop ancienne - " & arch: Exit Function
End Select
' Ici : Excel 16.x
Set reg = GetObject("winmgmts:\\.\root\default:StdRegProv")
key = "SOFTWARE\Microsoft\Office\ClickToRun\Configuration"
' 1) Lecture vue 64 bits (clé réelle C2R)
reg.GetStringValue &H80000006, key, "ProductReleaseIds", value
' 2) Si vide ? lecture vue 32 bits (rare mais possible)
If Len(value) = 0 Then
reg.GetStringValue &H80000002, key, "ProductReleaseIds", value
End If
' 3) Si toujours vide ? fallback LicensingNext
If Len(value) = 0 Then
key = "Software\Microsoft\Office\16.0\Common\Licensing\LicensingNext"
reg.EnumValues &H80000006, key, names, types
On Error GoTo Fallback2016
For i = 0 To UBound(names)
If InStr(names(i), "365") > 0 Then versionNum = 365: Exit For
If InStr(names(i), "2024") > 0 Then versionNum = 2024: Exit For
If InStr(names(i), "2021") > 0 Then versionNum = 2021: Exit For
If InStr(names(i), "2019") > 0 Then versionNum = 2019: Exit For
Next i
If versionNum = 0 Then GoTo Fallback2016
Else
' Détection via ProductReleaseIds
Select Case True
Case InStr(value, "O365") > 0: versionNum = 365
Case InStr(value, "2024") > 0: versionNum = 2024
Case InStr(value, "2021") > 0: versionNum = 2021
Case InStr(value, "2019") > 0: versionNum = 2019
Case InStr(value, "2016") > 0: versionNum = 2016
Case Else: versionNum = 2021
End Select
End If
VersionExcelComplete = CStr(versionNum) & " - " & arch
Exit Function
Fallback2016:
VersionExcelComplete = "2016 - " & arch
End Function
Sub TestVersionExcel()
Debug.Print VersionExcelComplete()
End Sub