Excel VBA シート上のオートシェイプ選択肢表示コピペ

Question

以下がやりたい事ですが、わかりません。可能でしょうか？

1.シート上に作成してあるオートシェイプの選択肢を出現
（オートシェイプの選択時にはオートシェイプ名ではなく、別名で選択したい、例えばGroup3というオートシェイプをボール等。もしくは、名前ではなくオートシェイプ自体が表示され図形で選択出来る形でも良いです。）

2.選択したオートシェイプが”ｃ20”にコピペされる

【現状】
任意のセル("A1,B5,D11,F3")に空白が無ければ("Group 3")を("C20")にコピペ
空白があった場合には確認が入り　YES　→　コピペ実行/NO　→　何もしない。

Sub sample()
If (Application.CountA(Range("A1,B5,D11,F3"))) <> 4 Then
If MsgBox("未入力の項目があります。" & vbCrLf & "承認してもいいですか？", vbYesNo) <> vbYes Then

Exit Sub
End If
End If

ActiveSheet.Shapes("Group 3").Copy
ActiveSheet.Paste Destination:=Range("C20")

End　sub

【完成形】
１．任意のセル("A1,B5,D11,F3")に空白が無ければオートシェイプ選択肢から選択しコピペ
２．空白有りの場合は、確認後Yesであればオートシェイプ選択肢へ

説明が下手ですいません。
今止まっている所はコンバットボタンのコードです。
リストには1と2と言う項目があり、コンバットボタンはOKと cancelです。
1を選択しokをした場合には"図1"
2を選択しokをした場合には"図2"をコピペ
キャンセルは戻る
としたいのですが…

補足日時：2021/02/28 10:47
通報する

通報する

Qchan1962 · Accepted Answer

こんばんは、
レスポンスに関してはお互い様です。許す事であれば気長に行きましょう。
時世の関係もあり、かなり高い確率でこのサイトを見るのは23時前後です。
いつずつ進んで行きましょう。
気になるのは、コンパイルエラーです。
コンパイルエラーとは、VBAプログラムの命令言語として成立しない事を
意味します。考えられる事はいくつか浮かびますが、検証する為に最小単位（すでに書かれているプログラムを外して）検証する事を提案します。
方法としては、新規ブックを作成し一旦、任意の名前および場所に保存してください。

そのブックを開きAlt+F11でVBEを表示します。
上の挿入タグよりユーザーフォームを挿入します。
同様に表示タグを選択してツールボックスを表示し、
テキストボックスをクリック、ユーザーフォーム上での十字キーを右クリックをしたまま範囲を作り、クリックを放すとテキストボックスが作成されます。　同様の手順でコマンドボタンを2つ作成します。

出来上がったら、ユーザーフォーム上でダブルクリックすると
Private Sub UserForm_Click()
と言う空のプロシージャがされます。
このプロシージャは、Delキーですべて削除してください。
このエリアに＃５で回答した
'実行ボタン以下

UserFormを表示する条件までのコードをコピペします。

次に挿入タグから標準モジュールをクリックして挿入します。
カーソルのある場所に
＃５で回答した

Sub 表示()
から
End Sub
までをコピペします。
コピペしたら、上のタグにあるデバッグをクリックして
VBAProjectのコンパイルをクリックします。
ここで、エラーが出なければ、一旦VBA言語として解釈されています。

次にシートの条件に出てくるセルの値などを入れVBA（表示）を実行します。
ここで処理内容はともかくとして実行されれば、（実行時の内容での）実行時エラーがないロジック、アルゴリズムが組まれている事になります。

期待している処理結果が得られれば、プログラムの完成です。
（内容の良し悪しを評価する事ではありません）

以上が、一通りのやり方の一例です。

まだ気になる点があります。OSやExcelのバージョンは何でしょう？
Macだったり、キングオフィスだったりしますか？であれば、初めから再構築しなくてはならないかも知れませんので、大事な事ですね。

補足ですが、
ファイルを提供するなどする方法がある事は、存じてい折りますが、
私は、ファイルの提供は行いません。
仮に実行コード（プロシージャとして成立する）を書いても、実行するご自身で確認、検証のもと、自己責任で行っていただきたいのと、アドバイスの範疇で実行プロシージャを書いており、あくまでも、デバッグ用サンプルとして書いています。

気にせず、解らない所があれば、出来れば具体的に補足、コメントをください。
内容を評価する気持ちは一切ありませんので、先ずこのご質問の内容に何だかの結果を出しましょう。

Qchan1962 · Answer

こんにちは
UserFormを使用しているのでしょうか？
取り敢えず、ListBoxを使用しているとして

Dim shpName As String
    With ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) = True Then
                shpName = .List(i)
                Exit For
            End If
        Next i
    End With

ActiveSheet.Shapes(shpName).Copy

リストが2つならループさせる必要はないかな。
ListBoxである必要もないかも。。

＞キャンセルは戻る
Unload Meの事？

Qchan1962 · Answer

＃１です。

UserFormに下記のオブジェクトがセットされている一例です
ListBox1
CommandButton1
CommandButton2

Private Sub CommandButton1_Click()
Dim shpName As String
Dim i As Integer
　 If (Application.CountA(Range("A1,B5,D11,F3"))) <> 4 Then
　　 If MsgBox("未入力の項目があります。" & _
　　 vbCrLf & "承認してもいいですか？", vbYesNo) <> vbYes Then
　　　　Exit Sub
　　 Else
　　　　With ListBox1
　　　　　 If .ListIndex = -1 Then
　　　　　　 MsgBox "リストを選択して下さい。"
　　　　　　 Exit Sub
　　　　　 Else
　　　　　　 shpName = .List(.ListIndex, 0)
　　　　　 End If
　　　　End With
　　 End If
　 End If

　 ActiveSheet.Shapes(shpName).Copy
　 ActiveSheet.Paste Destination:=Range("C20")

End Sub
Private Sub CommandButton2_Click()
'キャンセルボタン
　 Unload Me
End Sub
Private Sub UserForm_Initialize()
　 With ListBox1
　　 .AddItem "図１"
　　 .AddItem "図2"
　 End With
End Sub

Qchan1962 · Answer

続けざますみません
ループをやめたので
Dim i As Integer　は不要です。（使っていません）

Qchan1962 · Answer

>Worksheet上のオブジェクトにマクロを登録したいのですが出てこない
UserFormをお使いなら、下記の様に標準モジュールに書き
表示をボタンに登録すれば、UserFormが表示されます。
サンプルは、オブジェクト名UserForm1　です。

Sub 表示()
    UserForm1.Show
End Sub

Qchan1962 · Answer

＞コンパイルエラーと言う事はタイプミスしてしまったか、、すみません。または、コピペするところ違うとか、、？とにかく、整理してみましょう。ユーザーフォームを作成（UserForm1）して各オブジェクトを配置する。 UserFormでの処理 ListBox1　シェイプの名前が設定されている。＃２の回答は図１の1が全角になっていましたので半角に変更（実際の名前に合わせてください） CommandButton1　実行ボタン CommandButton2　キャンセルボタン対象フォームモジュール内に '実行ボタン Private Sub CommandButton1_Click() Dim shpName As String 　 With ListBox1 　　 If .ListIndex = -1 Then 'リストを選択しなかった時の処理　　　　MsgBox "リストを選択して下さい。" 　　　　Exit Sub 　　 Else 'リストボックスの選択されている値を変数に代入　　　　shpName = .List(.ListIndex, 0) 　　 End If 　 End With '対象のシェイプをコピー　 ActiveSheet.Shapes(shpName).Copy '貼り付け　 ActiveSheet.Paste Destination:=Range("C20") 'UserFormを閉じる（Unload）　 Unload Me End Sub Private Sub CommandButton2_Click() 'キャンセルボタン　 Unload Me End Sub Private Sub UserForm_Initialize() 'UserForm インスタンス時にListBox1の値を設定　 With ListBox1 　　 .AddItem "図1" 　　 .AddItem "図2" 　 End With End Sub UserFormを表示する条件表示：空白無しの場合空白があった場合にはmsgboxで続行した場合表示しない：他の場合はUserFormを表示しない UserFormを呼び出すコード（シェイプに登録）標準モジュールで Sub 表示() 　 If (Application.CountA(Range("A1,B5,D11,F3"))) <> 4 Then 　 '　空白あり　　 If MsgBox("未入力の項目があります。" & vbCrLf _ 　　 & "承認してもいいですか？", vbYesNo) <> vbYes Then 　 '　 NO 　　　　Exit Sub 　　 Else 　 '　続行した場合　　　　UserForm1.Show 　　 End If 　 Else 　 '　　空白無しの場合　　 UserForm1.Show 　 End If End Sub コンパイルエラーとは無関係ですが、条件の解釈が間違っていたようです。コメントを足しているので間違いないと思います。 VBEでコンパイルしてみたので大丈夫かと、、思います。ある程度ご自身で書いていたので大丈夫と思いますが、処理の手順や内容を理解して、ご自身で改修できるようにしてくださいね。

Qchan1962 · Answer

＞ずっとお付き合いいただきありがとうございます。
乗りかかった事なので気になさらないでください。ただ、レスポンスは良くないかも知れませんが。

>UserForm1.Show　　　←が黄色で警告が出てしまいます。
ユーザーフォーム作成していますか？
参考　https://www.sejuku.net/blog/37407

作成しているなら、コンパイル出来ますでしょうか？
実行前にVBEのデバッグタグからプロジェクトのコンパイルをしてみてください。
フォームモジュール内でエラーはありませんか？
オブジェクト名など確認してください。

>実行時エラー’70’
1004でなく70となると特定は少し難しいかな、、
セキュリティソフトなどによる権限の場合もありますし、
UserForm側のコンパイルエラーなどの可能性もあります。

各コードをコピペしたモジュールを教えてください。
Sub 表示()は、標準モジュール

Private Sub CommandButton1_Click()
Private Sub CommandButton2_Click()
Private Sub UserForm_Initialize()
はフォームモジュール（ボタンなどを配置しているUserForm）
です。

画像などを補足に入れて頂けるとわかり易いかも、、です。

さらに、お使いのOS,Office、Excelのバージョンなどを教えてもらえますか？

私のローカルでは、同様の事象は発生せず処理が出来ました。
Windows10 64bit Office Home and Business 2013  32bit15.0.5319
Windows10 64bit Office Home and Business Premium 2016 32bit