エクセル プロダクトIDを検出する方法が解りましたか゛それを使ってエクセルの操作ができませんか

質問

Sub プロダクトIDを表示する()
バージョン = Application.Version
一意識別子 = Application.ProductCode
レジストリキー = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\" _
& バージョン & "\Registration\" & 一意識別子 & "\ProductID"
プロダクトID = CreateObject("WScript.Shell").RegRead(レジストリキー)
MsgBox プロダクトID, , "プロダクトID"

End Sub
この様なコードを発見しました
プロダクトIDを使って　エクセルが起動した時にプロダクトIDを検出して保存しておいて　このプロダクトIDと違ったもので起動した時に開かないように　　　そんな事が実現できますでしょうか　ご指南ください

回答No.7

end-u · ベストアンサー

'ThisWorkbookModule
Option Explicit

Private Sub Workbook_Open()
　　Const HKEY = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\"
　　Dim v　As String　　'Version
　　Dim p　As String　　'ProductCode
　　Dim a　As String　　'Path
　　Dim k　As String　　'Key
　　Dim x
　　Dim ws As Worksheet

　　On Error Resume Next
　　With ThisWorkbook
　　　　Set ws = .Worksheets("mysheet")
　　　　If ws Is Nothing Then
　　　　　　Set ws = .Worksheets.Add
　　　　　　ws.Name = "mysheet"
　　　　End If
　　End With
　　ws.Visible = xlSheetVeryHidden

　　On Error GoTo errH
　　With Application
　　　　v = .Version
　　　　If Val(v) < 10 Then
　　　　　　a = HKEY & v & "\Registration\ProductID\"
　　　　Else
　　　　　　p = .ProductCode
　　　　　　a = HKEY & v & "\Registration\" & p & "\ProductID"
　　　　End If
　　End With
　　k = CreateObject("wscript.shell").Regread(a)

　　x = ws.Range("A1").Value
　　If IsEmpty(x) Then
　　　　ws.Range("A1").Value = k
　　Else
　　　　If x <> k Then
　　　　　　MsgBox "no"
　　　　　　'ThisWorkbook.Close False
　　　　Else
　　　　　　MsgBox "ok"
　　　　End If
　　End If
　　Set ws = Nothing
　　Exit Sub

errH:
　　MsgBox Err.Number & ":" & Err.Description
　　'ThisWorkbook.Close False
End Sub

...こんな感じです。
後は工夫してみてください。

お礼

とっても　勉強になりました
本当にありがとう御座いました。

回答No.6

end-u

ProductIDをどこかに記録する必要があります。
レジストリあるいは非表示シートのどこかのセル、など。
非表示シートの場合、マクロから表示されないようパスワード付きでBookの保護も必要。
例えばSheet1のA1セルに記録するとしたら、

'ThisWorkbookModule
Option Explicit

Private Sub Workbook_Open()
　　Const HKEY = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\"
　　Dim v As String　　'Version
　　Dim p As String　　'ProductCode
　　Dim a As String　　'Path
　　Dim k As String　　'Key
　　Dim x

　　On Error GoTo errH
　　With Application
　　　　v = .Version
　　　　'Excel2000の場合キー位置が違う。（と思う）
　　　　If Val(v) < 10 Then
　　　　　　a = HKEY & v & "\Registration\ProductID\"
　　　　Else
　　　　　　p = .ProductCode
　　　　　　a = HKEY & v & "\Registration\" & p & "\ProductID"
　　　　End If
　　End With
　　k = CreateObject("wscript.shell").Regread(a)
　　'MsgBox k

　　'隠しシートにProductIDを記憶するようにする。
　　x = Sheet1.Range("A1").Value
　　If IsEmpty(x) Then
　　　　Sheet1.Range("A1").Value = k
　　Else
　　　　If x <> k Then
　　　　　　MsgBox "no"
　　　　　　'ThisWorkbook.Close False
　　　　Else
　　　　　　MsgBox "ok"
　　　　End If
　　End If
　　Exit Sub

errH:
　　MsgBox Err.Number & ":" & Err.Description
End Sub

マクロ無効化対策については下記ページを参考に工夫してください。
http://homepage2.nifty.com/kmado/kvba.htm
（ここの E00M090 [マクロを無効にする]で開くと使えないxlsファイル ）

補足

ご指南ありがとう御座います
うまくいきました　本当にありがとう御座います
たとえば　'隠しシートにProductIDを記憶するようにする　なのですが
オープン時mysheetを作ってi65535にＩＤを格納の場合　どのように
すれば　良いのでしょうか　

よろしくお願いいたします

回答No.5

redfox63

> 初めて起動した時にフォームを出してID入力をさせて
というのも マクロが実行できることが前提です
マクロを禁止されてしまえば意味を成しません

マクロ起動が出来るのであれば UserFormに適切なコントロールとイベントハンドラを記述すれば可能です

補足

どのようにすればよいのでしょうか
ご指南よろしくお願いいたします

回答No.4

redfox63

>マクロを使用禁止 ----使用可能しか選択させないです
>Shift+クリック--------禁止にしたいです
これは無理でしょ

マクロの使用禁止はユーザーが ツール > マクロ > セキュリティで設定変更が可能です
あなたが渡す人に強制は出来てもそこから二次配布された先へ強制する術はありません
Shift＋Clickに関しても Excel自体を改変しなければ対処不能です
こちらも 少し調べれば簡単にマクロを起動時に実行させない方法としての情報が得られます

保存時のパスワードならあなたが配布した一次配布先の人間がパスワードを漏らさない限り二次配布先で読み込まれるのを大部分において回避できるように思います
ただ1つの弊害は一次配布先でも起動時に毎回パスワードを要求される点でしょう

補足

お返事ありがとう御座います
>一次配布先の人間がパスワードを漏らさない限り二次配布先
漏らしてしまうと意味がないので　色々と悩んでいます
たとえば　初めて起動した時にフォームを出してID入力をさせて開くたびにIDチェックをさせ違ったIDで開くと開かない同じID開くとフォームは出ない　その様は事の実現は無理でしょうか
よろしくお願いいたします。

回答No.3

redfox63

マクロを使用禁止にしていたりShift+クリックで起動した場合の対処はどのようにしますか
マクロは万能ではありませんよ

補足

マクロを使用禁止 ----使用可能しか選択させないです
Shift+クリック--------禁止にしたいです

よろしくお願いいたします

回答No.2

imogasi

疑問
１回目と２回目以降プロダクトIDが違う場合は、同じパソコンで実行していると、ありえないように思いますが。
他パソコンにコピーされて（あるいは実行プログラムを記録した媒体を他のパソコンに移して）実行されないようにしたいのでしょうか？
この場合は１度目にファイルにプロダクトIDを記録するとして、記録しても、他のパソコンに、プロダクトIDを書いたそのファイルが（本体ソフトとともに一緒に）移る仕組みが難しいと思うが。

補足

ありがとう御座います。
>他パソコンにコピーされて実行されないようにしたいのでしょうか
其の通りです。
渡した相手が他の人に渡した場合使用出来ないようにしたいのです。
よろしくお願いいたします

回答No.1

redfox63

ThisWorkbookモジュールのWorkbook_Openイベントで
プロダクトIDをレジストリーから取得して違ったら
バージョン = Application.Version
一意識別子 = Application.ProductCode
レジストリキー = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\" _
& バージョン & "\Registration\" & 一意識別子 & "\ProductID"
プロダクトID = CreateObject("WScript.Shell").RegRead(レジストリキー)
if プロダクトID <> "xxxxx-xxx-xxxxxxx-xxxxx" then
ThisWorkbook.Close
end if
などを実行すればいいのでは

私なら ブックの保存時のパスワードを設定するほうをお勧めしますが

補足

何時もありがとう御座います。　説明不足ですいません
１回目にファイルを開いた時にプロダクトID 取得
２回目以降は其の取得したIDとの整合性をチェックして開くか開かないかを決める。２回目以降を違うIDで開けない。　そんなを実現したいのです　よろしくお願いいたします。