|
こんにちは。
>確実にとれるのか
となるとよくわかりませんが、とりあえず私の環境では以下でとれました。
Sub license()
On Error Resume Next
Dim ProductVersion As String
'Dim ProductCodeID As String
Dim ExcelPath As String
Dim wsh As Object
Set wsh = CreateObject("WScript.Shell")
'Excelのバージョン情報、プロダクトコード取得
ProductVersion = Application.Version
'ProductCodeID = Application.ProductCode
'レジストリ読み込みキーの作成
ExcelPath = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\" _
& ProductVersion & "\Registration" & "\ProductID\" 'ProductCodeID & "\ProductID"
'ExcelのプロダクトID取得
Range("I2") = wsh.Regread(ExcelPath)
'ユーザ名セット
Range("I3") = Application.UserName
Set wsh = Nothing
End Sub
|
|