こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセル プロダクト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と違ったもので起動した時に開かないように   そんな事が実現できますでしょうか ご指南ください

投稿日時 - 2008-11-02 23:29:06

QNo.4449441

すぐに回答ほしいです

質問者が選んだベストアンサー

'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

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

投稿日時 - 2008-11-06 13:01:35

お礼

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

投稿日時 - 2008-11-06 14:02:00

ANo.7

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(7)

ANo.6

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ファイル )

投稿日時 - 2008-11-05 19:05:56

補足

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

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

投稿日時 - 2008-11-06 04:56:55

ANo.5

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

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

投稿日時 - 2008-11-04 15:43:10

補足

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

投稿日時 - 2008-11-04 21:00:13

ANo.4

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

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

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

投稿日時 - 2008-11-03 22:18:28

補足

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

投稿日時 - 2008-11-03 23:24:32

ANo.3

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

投稿日時 - 2008-11-03 17:44:45

補足

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

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

投稿日時 - 2008-11-03 20:00:20

ANo.2

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

投稿日時 - 2008-11-03 11:25:18

補足

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

投稿日時 - 2008-11-03 15:40:03

ANo.1

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
などを実行すればいいのでは

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

投稿日時 - 2008-11-03 00:09:27

補足

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

投稿日時 - 2008-11-03 00:55:23

あなたにオススメの質問