シートをコピーの時二つのコマンドボタン一つのみに

質問

いつもお世話になります。
WINDOWS7 EXCELL2010 です。

コピーしようとするシートには２ヶのコマンドボタンがあります。
２つのコマンドボタンとは下記の　「１　と　２」です。
コピーされたシートのコマンドボタン(SheetCopy)は不必要になり、
下記の　１　に↓の記述を追加したのですが二つのコマンドボタンが削除されました。

ActiveSheet.DrawingObjects.Delete

「２　クリアー」ボタンだけを残すには　↑　どういう具合に記述すればいいかを御指導いただけませんでしょうか。
宜しくお願いいたします。

参考に
１　コマンドボタン名「SheetCopy」
Sub SheetCopy()
'
' SheetCopy Macro
' 元本のシートをコピーする
' 2014/10/12 dorasuke

'
Dim NewSheetName As String

NewSheetName = InputBox("一桁の月及び日でも二桁のMMDD形式で新しいシート名を入力してください")

Sheets("元本").Copy After:=Sheets(1)
Sheets("元本 (2)").Select
Sheets("元本 (2)").Name = NewSheetName
Range("A1").Select
ActiveCell.FormulaR1C1 = NewSheetName
ActiveSheet.DrawingObjects.Delete

Range("A2").Select
End Sub

２　コマンドボタン名「クリアー」
Sub ClearCell()
Range("K3:S32").ClearContents
End Sub

回答No.3

watabe007 · ベストアンサー

No.1です。
>その結果、コピーしたシートには　コマンドボタンは削除されました。
>がしかし　もとになるシート「元本」にあったコマンドボタン「SheetCopy」まで削除されます。
シート「元本」にあるボタンを削除して、それをコピーした結果ですね
コピーしたシートのボタンを削除しましょう

Sub SheetCopy()
'
' SheetCopy Macro
' 元本のシートをコピーする
Dim NewSheetName As String

NewSheetName = InputBox("一桁の月及び日でも二桁のMMDD形式で新しいシート名を入力してください")

Sheets("元本").Copy After:=Sheets(1)
Sheets("元本 (2)").Select
Sheets("元本 (2)").Name = NewSheetName
Range("A1").Select
ActiveCell.FormulaR1C1 = NewSheetName
Range("A2").Select

　　Dim myBut As Object
　　For Each myBut In ActiveSheet.Buttons
　　　　If myBut.Caption = "SheetCopy" Then myBut.Delete
　　Next
End Sub

お礼

早速のご回答をありがとうございました。
試させていただいた結果ものの見事にできました。
今後ともよろしくお願いします。

回答No.2

cj_mover

こんにちは。

「フォーム コントロール　の　ボタン」
と
「ActiveX コントロール　の　コマンドボタン」
の区別や用語の使い分けが曖昧になっているようですから、
その点を、まず、ご自分で確かなものにするようにしてください。
Excel2010では、「フォーム コントロール　の　ボタン」のことを
「コマンドボタン」と呼ぶことはありません。
お使いのコントロールは、ボタンなのか、コマンドボタンなのか、
ハッキリと確認するようにしてください。
プロシージャの名前だけ見ると、
「フォーム コントロール　の　ボタン」だと判断するべきなのでしょう。
「ActiveX コントロール　の　コマンドボタン」ならば
　　Private Sub SheetCopy_Click()
または
　　Private Sub CommandButton1_Click()
というようなプロシージャになりますから。

削除するべきコントロールの「名前＝オブジェクト名」を把握しましょう。
> コマンドボタン名「SheetCopy」
ボタンに表示されている文字列＝Captionが、
ボタンの名前＝Nameと一致するとは限りませんが、
ご自分で、SheetCopyと名前を変更する手順を踏んでいますか？
コントロール挿入後の初期状態では、
「フォーム コントロール　の　ボタン」なら、Button 1
「ActiveX コントロール　の　コマンドボタン」なら、CommandButton1
という形式の名前が割り当てられます。
ボタンに表示される文字列を変更しても名前は変更されません。
CaptionとNameの違いを確認してください。

以下は、それらを確認する為だけのマクロです。
（メッセージを表示するだけで何も処理しません
（シート名だけは正しく指定してください）
'　' ///
Sub ChckButtons()
Dim o As Object
Dim s As String
　　For Each o In Worksheets("元本").DrawingObjects
　　　　Select Case TypeName(o)
　　　　Case "OLEObject"
　　　　　　If TypeName(o.Object) = "CommandButton" Then
　　　　　　　　s = s & vbLf & "オブジェクト名：" & o.Name
　　　　　　　　s = s & vbLf & vbTab & "タイプ：ActiveX コントロール/" & TypeName(o) & "/" & TypeName(o.Object)
　　　　　　　　s = s & vbLf & vbTab & "表示文字列：""" & o.Object.Caption & """"
　　　　　　End If
　　　　Case "Button"
　　　　　　s = s & vbLf & "オブジェクト名：" & o.Name
　　　　　　s = s & vbLf & vbTab & "タイプ：フォーム コントロール/" & TypeName(o)
　　　　　　s = s & vbLf & vbTab & "表示文字列：""" & o.Caption & """"
　　　　End Select
　　Next
　　MsgBox s
　　Debug.? s
End Sub
'　' ///

InputBoxに例えば、"0101"と入力されたとして、
セルにも"0101"と表示させたい場合は、
そのままでは、101 という数値を設定するだけになってしまいますから、
うまくいきません。
書式の表示形式を"0000"のように変更してあげる必要があります。

シートのコピーが済んだ後の処理対象は、すべて
コピー後のシートに限定されているようですから、
「コピー後のシートの」という意味が明確になるような書き方を
するようにしましょう。
セル範囲を捉えるのにも、「コピー後のシートの」「セル範囲」という
書き方をしないと失敗の元です。

「SheetCopy」に関連付けられているボタンまたはコマンドボタン
の削除方法を４通り書きました。
ボタン、コマンドボタンそれぞれ２通りずつです。
どちらでも構いませんが、普通は
「フォーム コントロール」「ActiveX コントロール」の違いを
読む人にも判るように★２または★４のような書き方をします。
上にあげたマクロを実行すれば、削除したいコントロールの名前が
判りますから、その名前を""ダブルクオートで括った文字列値を
'　　　　.Buttons("Button 1").Delete　'　　★２／四者択一
'　　　　.OLEObjects("CommandButton1").Delete　'　　★４／四者択一
のどちらかの括弧の中を書き換えてください。
コメントブロックの解除は、４つの内ひとつだけにして、
動作を確認出来たら要らない記述は削除して下さい。

オブジェクトの参照の仕方ですが、
　collection(index)
というのが基本的な書式として説明されることが多いですが、
このインデックスの部分を数字で指定するような方法は、
避けた方がいい場合が多いです。
例えば、Sheets(1)のような参照は、シートを並べ替えただけで、
期待とは違うオブジェクトを返してしまうからです。
　collection(name)
こういう書式で説明されることはまずありませんが、
　　Sheets("元本").Buttons("Button 1").Delete
　　Sheets("元本").DrawingObjects("CommandButton1").Delete
のように書いた方が確実性が増すとともに、
見てすぐ解るようになります。

以下のサンプルでは、With フレーズを使ってオブジェクトをブロック化して、
オブジェクトの参照を無駄に繰り返さず、且確実にするような書き方をしています。

'　' ///
'１　「SheetCopy」
Sub SheetCopy() '
Dim NewSheetName As String

　　NewSheetName = InputBox("一桁の月及び日でも二桁のMMDD形式で新しいシート名を入力してください")

　　Sheets("元本").Copy After:=Sheets("元本")
　　With ActiveSheet
　　　　.Name = NewSheetName
　　　　With .Range("A1")
　　　　　　.NumberFormatLocal = "0000"
　　　　　　.Value = NewSheetName
　　　　End With

' ' ---------------------------------------------------------------------------
　　' '　フォーム コントロール　の　ボタン　の場合
'　　　　.DrawingObjects("Button 1").Delete　'　　★１／四者択一
'　　　　.Buttons("Button 1").Delete　'　　★２／四者択一
　　' '　ActiveX コントロール　の　コマンドボタン　の場合
'　　　　.DrawingObjects("CommandButton1").Delete　'　　★３／四者択一
'　　　　.OLEObjects("CommandButton1").Delete　'　　★４／四者択一
' ' ---------------------------------------------------------------------------

　　　　.Range("A2").Select　　'　　必要？
　　End With
End Sub
'　' ///

お礼

御回答いただきありがとうございます。
また詳細なご説明には感謝しています。

昨夜遅くまでこのご指導を勉強しました。
これからの参考にさせてい頂きます。
重ね重ねありがとうございました。

回答No.1

watabe007

>ActiveSheet.DrawingObjects.Delete
ActiveXコントロールのコマンドボタンの
Captionが"SheetCopy"のボタンのみ削除
Dim myOLE As OLEObject
For Each myOLE In ActiveSheet.OLEObjects
　　If myOLE.Object.Caption = "SheetCopy" Then myOLE.Delete
Next
もしフォームコントロールのボタンなら
Dim myBut As Object
For Each myBut In ActiveSheet.Buttons
　　If myBut.Caption = "SheetCopy" Then myBut.Delete
Next

補足

早速のご回答ありがとうございます。
「SheetCopy」のコマンドボタンを　テキストボックスからフォームコントロールのボタン　に作り替え下記のようにマクロを記述しました。
その結果、コピーしたシートには　コマンドボタンは削除されました。
がしかし　もとになるシート「元本」にあったコマンドボタン「SheetCopy」まで削除されます。　このコマンドボタンはそのままにして残したいのですが
再度ご指導いただけないでしょうか。

Sub SheetCopy()
'
' SheetCopy Macro
' 元本のシートをコピーする
'
Dim myBut As Object
For Each myBut In ActiveSheet.Buttons
If myBut.Caption = "SheetCopy" Then myBut.Delete
Next

'
Dim NewSheetName As String

NewSheetName = InputBox("一桁の月及び日でも二桁のMMDD形式で新しいシート名を入力してください")

Sheets("元本").Copy After:=Sheets(1)
Sheets("元本 (2)").Select
Sheets("元本 (2)").Name = NewSheetName
Range("A1").Select
ActiveCell.FormulaR1C1 = NewSheetName
Range("A2").Select
End Sub