Excel VBA質問箱 IV

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

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


16601 / 76734 ←次へ | 前へ→

【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コントロール)での仕様変更を
検討してみてください。
1 hits

【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 お礼

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