Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


2854 / 13646 ツリー ←次へ | 前へ→

【65594】コマンドボタン等のコピー 亜矢 10/6/12(土) 7:29 質問[未読]
【65597】Re:コマンドボタン等のコピー カリーニン 10/6/12(土) 23:24 発言[未読]
【65598】Re:コマンドボタン等のコピー ichinose 10/6/13(日) 10:27 発言[未読]
【65603】Re:コマンドボタン等のコピー 亜矢 10/6/13(日) 13:35 お礼[未読]

【65594】コマンドボタン等のコピー
質問  亜矢  - 10/6/12(土) 7:29 -

引用なし
パスワード
   よろしくお願いします。
シートを追加した時に他のシート(同じブック)にあるコマンドボタン(Activexコントロール)3つをコピー(コードも)したいのですが、方法がわかりません。
教えていただきたいと思います。

【65597】Re:コマンドボタン等のコピー
発言  カリーニン  - 10/6/12(土) 23:24 -

引用なし
パスワード
   直近の↓は参考になりませんか?

コマンドボタンの共通Macro
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=65567;id=excel

【65598】Re:コマンドボタン等のコピー
発言  ichinose  - 10/6/13(日) 10:27 -

引用なし
パスワード
   ▼亜矢 さん:
こんにちは。
>シートを追加した時に他のシート(同じブック)にあるコマンドボタン(Activexコントロール)3つをコピー(コードも)したいのですが、方法がわかりません。

コピー(コードも)  は、ボタンのコピーと共にシートモジュールにある
イベントプロシジャーも同じようにコピーするという意味ですよね?

これは、Vbprojectを操作すれば、可能ですが、セキュリティを下げなければなりません。このセキュリティを下げる事の危険をあまりわかっていない方もこのプログラムを
使う対象になっているなら、こんな仕様は避けなければなりません。

簡単な方法は、このコマンドボタンをActiveXコントロールのそれから、
Excelコントロールのボタンに代える仕様にすることです。
これがカリーニンさんがリンクされたスレッドで私が投稿した事なんですが・・・。
他にもコマンドバーを新規に作成し、そこのボタンを配置する方法も仕様によっては、
考えられます。

ActiveXコントロールのコマンドボタンを使う方法でも出来そうではありますが・・・。

簡単な例として新規ブックにて試してください。

クラスモジュールを二つ作成してください(クラス名は、Class1とClass2)。

Class2のモジュールに

'==================================================================
Option Explicit
Public parent As Object
Public callnm As String
Public WithEvents btn As MSForms.CommandButton
Public sht As Worksheet
'==================================================================
Private Sub btn_Click()
  CallByName parent, callnm, VbMethod, btn, sht
End Sub


Class1のモジュール

'==================================================================
Private col As Collection
Event click(ByVal btn As MSForms.CommandButton, ByVal sht As Worksheet)
'==================================================================
Private Sub Class_Initialize()
  Set col = New Collection
End Sub
'==================================================================
Private Sub Class_Terminate()
  On Error Resume Next
  Set col = notihng
End Sub
'==================================================================
Sub entry_btn(ByVal ebtn As MSForms.CommandButton, ByVal sht As Worksheet)
  Dim cls As Class2
  Set cls = New Class2
  Set cls.parent = Me
  cls.callnm = "click_ev"
  Set cls.btn = ebtn
  Set cls.sht = sht
  col.Add cls
End Sub
'==================================================================
Sub click_ev(ByVal btn As MSForms.CommandButton, ByVal sht As Worksheet)
  RaiseEvent click(btn, sht)
End Sub


Thisworkbookのモジュールに

'==================================================================
Option Explicit
Private WithEvents cls As Class1
'==================================================================
Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Call term_cls
End Sub
'==================================================================
Private Sub Workbook_NewSheet(ByVal Sh As Object)
  Dim ole As OLEObject
  Dim r As Range
  Dim btn As MSForms.CommandButton
  Set ole = Worksheets("sheet1").OLEObjects(1)
  ole.Copy
  Sh.Select
  Sh.Paste
  Sh.Range("a1").Select
  Set r = Range("b2:c5")
  With Sh.OLEObjects(1)
    .Left = r.Left
    .Top = r.Top
    .Width = r.Width
    .Height = r.Height
  End With
  Set btn = Sh.OLEObjects(1).Object
  setev_cls btn, Sh
End Sub
'==================================================================
Private Sub Workbook_Open()
  Dim sht As Worksheet
  Dim ole As OLEObject
  Call init_cls
  For Each sht In ThisWorkbook.Worksheets
    For Each ole In sht.OLEObjects
     If TypeName(ole.Object) = "CommandButton" Then
       Call setev_cls(ole.Object, sht)
     End If
    Next
  Next
End Sub
'==================================================================
Sub init_cls()
  Set cls = New Class1
End Sub
'==================================================================
Sub term_cls()
  Set cls = Nothing
End Sub
'==================================================================
Sub setev_cls(ByVal btn As MSForms.CommandButton, ByVal sht As Worksheet)
  cls.entry_btn btn, sht
End Sub
'==================================================================
Private Sub cls_click(ByVal btn As MSForms.CommandButton, ByVal sht As Worksheet)
  MsgBox sht.Name & "  の  " & btn.Name
End Sub


最後に標準モジュール(Module1)に

'======================================================================
Sub mk_btnsamp()
  Dim r As Range
  Dim btn As MSForms.CommandButton
  Set r = Range("b2:c5")
  Set btn = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
    , DisplayAsIcon:=False, Left:=r.Left, Top:=r.Top, Width:=r.Width, Height:=r.Height).Object
  btn.TakeFocusOnClick = False
End Sub


コードは以上です。

VBEの参照設定にて、「Microsoft Forms 2.0 Object Library」にチェックを
入れてください。

適当なシートをアクティブにして、mk_btnsampを実行してください。
アクティブシートにコマンドボタンが作成されます。このコマンドボタンが
コピー元のコマンドボタンです。


ここで適当な名前でブックを保存して、一度このブックを閉じてください。
再度、ブックを開いてください。
作成されているコマンドボタンをクリックしてください。

シート名 の コマンドボタン名 というメッセージが表示されるはずです。

「挿入」----「ワークシート」とクリックしてください。
挿入されたワークシートに事前に作成したコマンドボタンがコピーされてます。
クリックすると、シート名 の コマンドボタン名 というメッセージが表示されるはずです。

試してみてください。

Excel2002では、コマンドボタンのコピー&ペーストでは、モジュールレベルの変数の
初期化は行われませんでしたので、提示したコードで正常に動作しました。

が、何かの仕様追加で動的にこのコマンドボタンを作成した場合、前述の
モジュールレベルの変数の初期化が行われて正常に作動しません。
回避方法は、ありますが、更に面倒になります。

コマンドバー「フォーム」ボタン(Excelコントロール)での仕様変更を
検討してみてください。

【65603】Re:コマンドボタン等のコピー
お礼  亜矢  - 10/6/13(日) 13:35 -

引用なし
パスワード
   ▼ichinose さん:
>▼亜矢 さん:
>こんにちは。
>>シートを追加した時に他のシート(同じブック)にあるコマンドボタン(Activexコントロール)3つをコピー(コードも)したいのですが、方法がわかりません。
>
>コピー(コードも)  は、ボタンのコピーと共にシートモジュールにある
>イベントプロシジャーも同じようにコピーするという意味ですよね?
>
>これは、Vbprojectを操作すれば、可能ですが、セキュリティを下げなければなりません。このセキュリティを下げる事の危険をあまりわかっていない方もこのプログラムを
>使う対象になっているなら、こんな仕様は避けなければなりません。
>
>簡単な方法は、このコマンドボタンをActiveXコントロールのそれから、
>Excelコントロールのボタンに代える仕様にすることです。
>これがカリーニンさんがリンクされたスレッドで私が投稿した事なんですが・・・。
>他にもコマンドバーを新規に作成し、そこのボタンを配置する方法も仕様によっては、
>考えられます。
>
>ActiveXコントロールのコマンドボタンを使う方法でも出来そうではありますが・・・。
>
>簡単な例として新規ブックにて試してください。
>
>クラスモジュールを二つ作成してください(クラス名は、Class1とClass2)。
>
>Class2のモジュールに
>
>'==================================================================
>Option Explicit
>Public parent As Object
>Public callnm As String
>Public WithEvents btn As MSForms.CommandButton
>Public sht As Worksheet
>'==================================================================
>Private Sub btn_Click()
>  CallByName parent, callnm, VbMethod, btn, sht
>End Sub
>
>
>Class1のモジュール
>
>'==================================================================
>Private col As Collection
>Event click(ByVal btn As MSForms.CommandButton, ByVal sht As Worksheet)
>'==================================================================
>Private Sub Class_Initialize()
>  Set col = New Collection
>End Sub
>'==================================================================
>Private Sub Class_Terminate()
>  On Error Resume Next
>  Set col = notihng
>End Sub
>'==================================================================
>Sub entry_btn(ByVal ebtn As MSForms.CommandButton, ByVal sht As Worksheet)
>  Dim cls As Class2
>  Set cls = New Class2
>  Set cls.parent = Me
>  cls.callnm = "click_ev"
>  Set cls.btn = ebtn
>  Set cls.sht = sht
>  col.Add cls
>End Sub
>'==================================================================
>Sub click_ev(ByVal btn As MSForms.CommandButton, ByVal sht As Worksheet)
>  RaiseEvent click(btn, sht)
>End Sub
>
>
>Thisworkbookのモジュールに
>
>'==================================================================
>Option Explicit
>Private WithEvents cls As Class1
>'==================================================================
>Private Sub Workbook_BeforeClose(Cancel As Boolean)
>  Call term_cls
>End Sub
>'==================================================================
>Private Sub Workbook_NewSheet(ByVal Sh As Object)
>  Dim ole As OLEObject
>  Dim r As Range
>  Dim btn As MSForms.CommandButton
>  Set ole = Worksheets("sheet1").OLEObjects(1)
>  ole.Copy
>  Sh.Select
>  Sh.Paste
>  Sh.Range("a1").Select
>  Set r = Range("b2:c5")
>  With Sh.OLEObjects(1)
>    .Left = r.Left
>    .Top = r.Top
>    .Width = r.Width
>    .Height = r.Height
>  End With
>  Set btn = Sh.OLEObjects(1).Object
>  setev_cls btn, Sh
>End Sub
>'==================================================================
>Private Sub Workbook_Open()
>  Dim sht As Worksheet
>  Dim ole As OLEObject
>  Call init_cls
>  For Each sht In ThisWorkbook.Worksheets
>    For Each ole In sht.OLEObjects
>     If TypeName(ole.Object) = "CommandButton" Then
>       Call setev_cls(ole.Object, sht)
>     End If
>    Next
>  Next
>End Sub
>'==================================================================
>Sub init_cls()
>  Set cls = New Class1
>End Sub
>'==================================================================
>Sub term_cls()
>  Set cls = Nothing
>End Sub
>'==================================================================
>Sub setev_cls(ByVal btn As MSForms.CommandButton, ByVal sht As Worksheet)
>  cls.entry_btn btn, sht
>End Sub
>'==================================================================
>Private Sub cls_click(ByVal btn As MSForms.CommandButton, ByVal sht As Worksheet)
>  MsgBox sht.Name & "  の  " & btn.Name
>End Sub
>
>
>最後に標準モジュール(Module1)に
>
>'======================================================================
>Sub mk_btnsamp()
>  Dim r As Range
>  Dim btn As MSForms.CommandButton
>  Set r = Range("b2:c5")
>  Set btn = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
>    , DisplayAsIcon:=False, Left:=r.Left, Top:=r.Top, Width:=r.Width, Height:=r.Height).Object
>  btn.TakeFocusOnClick = False
>End Sub
>
>
>コードは以上です。
>
>VBEの参照設定にて、「Microsoft Forms 2.0 Object Library」にチェックを
>入れてください。
>
>適当なシートをアクティブにして、mk_btnsampを実行してください。
>アクティブシートにコマンドボタンが作成されます。このコマンドボタンが
>コピー元のコマンドボタンです。
>
>
>ここで適当な名前でブックを保存して、一度このブックを閉じてください。
>再度、ブックを開いてください。
>作成されているコマンドボタンをクリックしてください。
>
>シート名 の コマンドボタン名 というメッセージが表示されるはずです。
>
>「挿入」----「ワークシート」とクリックしてください。
>挿入されたワークシートに事前に作成したコマンドボタンがコピーされてます。
>クリックすると、シート名 の コマンドボタン名 というメッセージが表示されるはずです。
>
>試してみてください。
>
>Excel2002では、コマンドボタンのコピー&ペーストでは、モジュールレベルの変数の
>初期化は行われませんでしたので、提示したコードで正常に動作しました。
>
>が、何かの仕様追加で動的にこのコマンドボタンを作成した場合、前述の
>モジュールレベルの変数の初期化が行われて正常に作動しません。
>回避方法は、ありますが、更に面倒になります。
>
>コマンドバー「フォーム」ボタン(Excelコントロール)での仕様変更を
>検討してみてください。
いろいろお手数をお掛けしました。上記のプログラムの見て中々理解できません。
フォームボタンの仕様に変更することと他の方法を検討することにします。
ありがとうございました。

2854 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free