| 
    
     |  | こんにちは。 >確実にとれるのか
 となるとよくわかりませんが、とりあえず私の環境では以下でとれました。
 
 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
 
 
 |  |