Sub En_Attendant_L_Ami_Ricoré()
Dim m$, vNu
With Application
m = "Version: " & .Version & vbCrLf
m = m & "Build: " & .Build & vbCrLf
m = m & "Code Produit: " & .ProductCode & vbCrLf
m = m & "Chemin Librairies: " & vbCrLf & .LibraryPath & vbCrLf
End With
MsgBox m, 64, "Infos"
vNu = Split(Split(Application.LibraryPath, "\")(2))(2)
MsgBox "Excel, c'est quoi ton numéro?" & vbCrLf & "C'est le: " & vNu, 48, ";-)"
End Sub
''Dim oRegistry
''Dim oFSO
''Dim sKey
''Dim sAppExe
''Dim sValue
''Dim sAppVersion
''Const HKEY_LOCAL_MACHINE = &H80000002
''Sub TestOK_W10_XL2K13()
'''adapté d'un vbscript de D. Pineault [231013]
''Set oRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}//./root/default:StdRegProv")
''Set oFSO = CreateObject("Scripting.FileSystemObject")
''sKey = "Software\Microsoft\Windows\CurrentVersion\App Paths"
''sAppExe = "excel.exe"
''oRegistry.GetStringValue HKEY_LOCAL_MACHINE, sKey & "\" & sAppExe, "", sValue
''MsgBox oFSO.GetFileVersion(sValue), vbInformation, "Excel File Version"
''Set oFSO = Nothing
''Set oRegistry = Nothing
''End Sub
Private Function zAppVersion()
Select Case Val(Application.Evaluate("INFO(""VERSION"")"))
Case 16
'?
Case 15
zAppVersion = 2013
Case 14
zAppVersion = 2010
Case Is = 12
zAppVersion = 2007
Case Else
'Too old to bother with
zAppVersion = 0
End Select
End Function
Sub Check_3()
MsgBox "You are running Excel " & CStr(zAppVersion), vbInformation, "Test"
End Sub
Public Function AppVersion() As Long
Dim registryObject As Object
Dim rootDirectory As String
Dim keyPath As String
Dim arrEntryNames As Variant
Dim arrValueTypes As Variant
Dim x As Long
Select Case Val(Application.Version)
Case Is = 16
'Check for existence of Licensing key
keyPath = "Software\Microsoft\Office\" & CStr(Application.Version) & "\Common\Licensing\OlsToken"
rootDirectory = "."
Set registryObject = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & rootDirectory & "\root\default:StdRegProv")
registryObject.EnumValues &H80000001, keyPath, arrEntryNames, arrValueTypes
On Error GoTo ErrorExit
For x = 0 To UBound(arrEntryNames)
If InStr(arrEntryNames(x), "365") > 0 Then
AppVersion = 365
Exit Function
End If
If InStr(arrEntryNames(x), "2019") > 0 Then
AppVersion = 2019
Exit Function
End If
Next x
Case Is = 15
AppVersion = 2013
Case Is = 14
AppVersion = 2010
Case Is = 12
AppVersion = 2007
Case Else
'Too old to bother with
AppVersion = 0
End Select
Exit Function
ErrorExit:
'Version 16, but no licensing key. Must be Office 2016
AppVersion = 2016
End Function