Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

4763 / 13657 ﾂﾘｰ

←次へ　｜　前へ→

▼

【54635】オブジェクトを選択状態でmsgbox表示 ひげくま 08/3/25(火) 10:31

【54638】Re:オブジェクトを選択状態でmsgbox表示 Jaka 08/3/25(火) 11:00

【54639】Re:オブジェクトを選択状態でmsgbox表示 ひげくま 08/3/25(火) 11:04

【54643】Re:オブジェクトを選択状態でmsgbox表示 Jaka 08/3/25(火) 11:33

【54646】Re:オブジェクトを選択状態でmsgbox表示 ひげくま 08/3/25(火) 11:51

【54655】Re:オブジェクトを選択状態でmsgbox表示 Jaka 08/3/25(火) 14:51

【54657】Re:オブジェクトを選択状態でmsgbox表示 ひげくま 08/3/25(火) 14:57

【54660】Re:オブジェクトを選択状態でmsgbox表示 Jaka 08/3/25(火) 15:47

【54683】Re:オブジェクトを選択状態でmsgbox表示 VBWASURETA 08/3/26(水) 9:14

【54686】Re:オブジェクトを選択状態でmsgbox表示 ichinose 08/3/26(水) 10:30

【54688】Re:オブジェクトを選択状態でmsgbox表示 VBWASURETA 08/3/26(水) 12:02

【54689】Re:オブジェクトを選択状態でmsgbox表示 ichinose 08/3/26(水) 12:38

【54690】Re:オブジェクトを選択状態でmsgbox表示 VBWASURETA 08/3/26(水) 12:56

【54701】Re:オブジェクトを選択状態でmsgbox表示 ichinose 08/3/26(水) 17:32

【54640】Re:オブジェクトを選択状態でmsgbox表示 VBWASURETA 08/3/25(火) 11:06

【54644】Re:オブジェクトを選択状態でmsgbox表示 ひげくま 08/3/25(火) 11:34

【54645】Re:オブジェクトを選択状態でmsgbox表示 VBWASURETA 08/3/25(火) 11:47

【54647】Re:オブジェクトを選択状態でmsgbox表示 ひげくま 08/3/25(火) 11:53

【54648】Re:オブジェクトを選択状態でmsgbox表示 VBWASURETA 08/3/25(火) 11:57

【54649】Re:オブジェクトを選択状態でmsgbox表示 ひげくま 08/3/25(火) 12:01

【54650】Re:オブジェクトを選択状態でmsgbox表示 ひげくま 08/3/25(火) 12:01

【54651】Re:オブジェクトを選択状態でmsgbox表示 VBWASURETA 08/3/25(火) 12:42

【54682】Re:オブジェクトを選択状態でmsgbox表示再... ichinose 08/3/26(水) 7:07


	【54635】オブジェクトを選択状態でmsgbox表示

ひげくま - 08/3/25(火) 10:31 -


	引用なし

	パスワード

線や四角などのオブジェクトが含まれる範囲を削除すると、オブジェクトも消えますが、実際には、幅や高さが0になって見えなくなっている(罫線と重なっている)だけで、オブジェクト自体は消えていません。いろんな人の手を渡ると、どこに見えないオブジェクトがあるのか判らなくなります。オブジェクトはそれなりに容量を食うので、できればそのようなオブジェクトは無いほうが良いです。そこで、そのようなオブジェクトを見つけて、選択状態(オブジェクトを触ったときの状態)にして、それを消すかどうかの確認メッセージを出して、Yesの場合に削除する、というマクロが欲しくて、以下のように作ってみました。 Sub Macro1() 　　Dim ooo As Object 　　　　For Each ooo In ActiveSheet.Shapes 　　　　ooo.TopLeftCell.Select　'オブジェクトを画面内に表示するため　　　　ooo.Select　'どのオブジェクトなのかが判るように　　　　　　　　If MsgBox("このオブジェクトを削除しますか？", _ 　　　　　　　　vbYesNo + vbDefaultButton2 + vbQuestion) = vbYes Then 　　　　　　ooo.Delete 　　　　End If 　　Next ooo 　　MsgBox "end" 　　　　Set ooo = Nothing End Sub ステップ実行[F8]では、狙い通りになるのですが、通常実行[F5]では、選択状態にならないまま確認メッセージが出てしまいます。なので、「このオブジェクト」がどのオブジェクトなのか判りません。同じセルに、必要なオブジェクトと不要なオブジェクトがある場合もあります。通常実行でも、オブジェクトが選択状態で確認メッセージが出るような方法(工夫)は無いものでしょうか？よろしくお願いします。


	【54638】Re:オブジェクトを選択状態でmsgbox表示

Jaka - 08/3/25(火) 11:00 -


	引用なし

	パスワード

>通常実行でも、オブジェクトが選択状態で確認メッセージが出るような方法(工夫)は無いものでしょうか？
通常実行といっても、VBE上からの実行ですよね。
VBE上からでなく、ボタン等にマクロ登録して実行するか、マクロ→マクロから実行してみるとどうでしょうか？
フォーカスの問題だと思うんですが、同じよう状況で確認を摂ってません。


	【54639】Re:オブジェクトを選択状態でmsgbox表示

ひげくま - 08/3/25(火) 11:04 -


	引用なし

	パスワード

▼Jaka さん：
>VBE上からでなく、ボタン等にマクロ登録して実行するか、マクロ→マクロから実行してみるとどうでしょうか？

ご指摘を受けて、どちらの方法も試してみましたが、どちらでもフォーカスされませんでした・・・


	【54640】Re:オブジェクトを選択状態でmsgbox表示

VBWASURETA - 08/3/25(火) 11:06 -


	引用なし

	パスワード

▼ひげくまさん：
おはようございます。

ちょっと試しに見てみましたが、
どうも選択画面になってないだけで選択はされているようですよ。
Selectの戻り値がTrueでしたから。Sleep入れてみたりもしましたけど
マクロ実行中は選択できているのか見えないですね。

面倒かも知れませんが、矢印オブジェクトを生成してこれと
わかるようにするとかの方法になるのかなっと思います。


	【54643】Re:オブジェクトを選択状態でmsgbox表示

Jaka - 08/3/25(火) 11:33 -


	引用なし

	パスワード

▼ひげくまさん：
>ご指摘を受けて、どちらの方法も試してみましたが、どちらでもフォーカスされませんでした・・・
すみません。
なんか仕様っぽいですね。

　　　　If MsgBox("このオブジェクトを削除しますか？", _
　　　　　　　　vbYesNo + vbDefaultButton2 + vbQuestion) = vbYes Then
　　　　　　'ooo.Delete　 ←これをコメントにすると選択されてますよね。
　　　　End If

また、図形選択後に
Msgbox 12222
とやっただけでも、選択されているのが見えなくなりますね。
今のところ代替案が思い浮かびません。
すみません。


	【54644】Re:オブジェクトを選択状態でmsgbox表示

ひげくま - 08/3/25(火) 11:34 -


	引用なし

	パスワード

▼VBWASURETA さん：
>どうも選択画面になってないだけで選択はされているようですよ。

はい。内部で選択されているのは解っています。
フォーカスされないと、どのオブジェクトを消そうとしているのか、ユーザーが判断できないので困っています。

>Sleep入れてみたりもしましたけど
>マクロ実行中は選択できているのか見えないですね。

Sleepという方法もあるんですね。
それでも駄目でしたか・・・

>面倒かも知れませんが、矢印オブジェクトを生成してこれと
>わかるようにするとかの方法になるのかなっと思います。

そういう方法しか無いんですかねぇ・・・
その方法だと、見えている必要なオブジェクトと、隠れている不要なオブジェクトが同じ位置にあった場合に、やはり判別がつかなくなるという恐れがあるんですよ・・・


	【54645】Re:オブジェクトを選択状態でmsgbox表示

VBWASURETA - 08/3/25(火) 11:47 -


	引用なし

	パスワード

>そういう方法しか無いんですかねぇ・・・
>その方法だと、見えている必要なオブジェクトと、隠れている不要なオブジェクトが同じ位置にあった場合に、やはり判別がつかなくなるという恐れがあるんですよ・・・

それか別の新規のシートにオブジェクトを移すのはダメですか？
それであれば区別もつきますし。


	【54646】Re:オブジェクトを選択状態でmsgbox表示

ひげくま - 08/3/25(火) 11:51 -


	引用なし

	パスワード

▼Jaka さん：
>また、図形選択後に
>Msgbox 12222
>とやっただけでも、選択されているのが見えなくなりますね。

[F5]だとフォーカスされたままなのに、ツールメニューから実行するとフォーカスが解除されちゃうんですね・・・

>今のところ代替案が思い浮かびません。
>すみません。

謝っていただくなんて、こちらこそ恐縮です。


	【54647】Re:オブジェクトを選択状態でmsgbox表示

ひげくま - 08/3/25(火) 11:53 -


	引用なし

	パスワード

▼VBWASURETA さん：
>それか別の新規のシートにオブジェクトを移すのはダメですか？

必要なオブジェクトの場合は、できるだけ触りたくないんですよ。
すみません。


	【54648】Re:オブジェクトを選択状態でmsgbox表示

VBWASURETA - 08/3/25(火) 11:57 -


	引用なし

	パスワード

>必要なオブジェクトの場合は、できるだけ触りたくないんですよ。
>すみません。

移すのがだめでしたらコピーして見れば全く触らないですよ？


	【54649】Re:オブジェクトを選択状態でmsgbox表示

ひげくま - 08/3/25(火) 12:01 -


	引用なし

	パスワード

▼VBWASURETA さん：
>移すのがだめでしたらコピーして見れば全く触らないですよ？

なるほど。

・・・でも、オブジェクトだけだと、必要なのか不要なのかを判断するのが難しくなりそうな気が・・・


	【54650】Re:オブジェクトを選択状態でmsgbox表示

ひげくま - 08/3/25(火) 12:01 -


	引用なし

	パスワード

いろいろヒントをいただき、とりあえず、オブジェクトの四隅をそれぞれ矢印オブジェクトで示して、オブジェクトのTypeプロパティを確認メッセージに明示することで、何とかしたいと思います。

Jakaさん、VBWASURETAさん、どうもありがとうございました。


	【54651】Re:オブジェクトを選択状態でmsgbox表示

VBWASURETA - 08/3/25(火) 12:42 -


	引用なし

	パスワード

▼ひげくまさん,Jakaさん：

多分ですが、マクロの仕様と思いますね。
マクロ実行中(DoEventsでやってみました)に手動でオブジェクトを
選択しても選択表示になりませんでしたし。


	【54655】Re:オブジェクトを選択状態でmsgbox表示

Jaka - 08/3/25(火) 14:51 -


	引用なし

	パスワード

これで精一杯。

Sub ababa()
　　Dim Cbr As CommandBar, CLb As CommandBarControl
　　Dim CBB As CommandBarButton, ooo As Shape
　　On Error Resume Next
　　Application.CommandBars("図形の削除").Delete
　　Set Cbr = Application.CommandBars.Add(Name:="図形の削除")
　　
　　Set CLb = Cbr.Controls.Add(msoControlEdit)
　　Cbr.Controls(1).Text = "このオブジェクトを削除しますか？"
　　Cbr.Controls(1).Width = 200
　　
　　Set CBB = Cbr.Controls.Add(msoControlButton)
　　CBB.Style = msoButtonCaption
　　CBB.Caption = "ＯＫ"
　　CBB.OnAction = "'実行マクロ(1)'"
　　Set CBB = Nothing
　　
　　Set CBB = Cbr.Controls.Add(msoControlButton)
　　CBB.Style = msoButtonCaption
　　CBB.Caption = "ＮＯ"
　　CBB.OnAction = "'実行マクロ(2)'"
　　Set CBB = Nothing
　　Cbr.Protection = msoBarNoChangeVisible
　　Cbr.Visible = True
　　For Each ooo In ActiveSheet.Shapes
　　　　ooo.TopLeftCell.Select　'オブジェクトを画面内に表示するため
　　　　'ooo.Select
　　
　　　　Flg = False
　　　
　　　　Do Until Flg = True
　　　　　 If ooo.Visible = msoTrue Then
　　　　　　　ooo.Visible = False
　　　　　 Else
　　　　　　　ooo.Visible = True
　　　　　 End If
　　　　　 ActiveCell.Select
　　　　　 DoEvents
　　　　　 'Application.Wait Now + TimeValue("00:00:01")
　　　　　 Sleep 100
　　　　Loop
　　　　ooo.Visible = True
　　　　'↑　図形を削除した場合はエラーになるから適当に修正してください。
　　Next
　　Application.CommandBars("図形の削除").Delete
End Sub

'この辺も適当に修正してください。
Sub 実行マクロ(No As Variant)
If No = 1 Then
　 MsgBox "削除"
ElseIf No = 2 Then
　 MsgBox "保留"
End If
Flg = True
End Sub

Sub dmdfk()
Application.CommandBars("図形の削除").Delete
End Sub


	【54657】Re:オブジェクトを選択状態でmsgbox表示

ひげくま - 08/3/25(火) 14:57 -


	引用なし

	パスワード

▼Jaka さん：
>これで精一杯。

わざわざありがとうございます。

私が勉強不足のため、いろいろ調べながらじゃないと、ちょっと解らないレベルになってきました(苦笑)
じっくり理解してみようと思います。


	【54660】Re:オブジェクトを選択状態でmsgbox表示

Jaka - 08/3/25(火) 15:47 -


	引用なし

	パスワード

　　　　略
>　　Set CBB = Nothing
>　　Cbr.Protection = msoBarNoChangeVisible
>　　Cbr.Visible = True
　 Application.CommandBars.DisableCustomize = True '←追加
>　　For Each ooo In ActiveSheet.Shapes
>　　　　ooo.TopLeftCell.Select　'オブジェクトを画面内に表示するため

　　　　略

>　　Next
>　　Application.CommandBars("図形の削除").Delete
　 Application.CommandBars.DisableCustomize = False '←追加
>End Sub


	【54682】Re:オブジェクトを選択状態でmsgbox表示...

ichinose - 08/3/26(水) 7:07 -


	引用なし

	パスワード

おはようございます。
ちょっと、投稿したものを検証していたらいくつか問題があったので再送です。

▼ひげくまさん：
こんばんは。
私も考えてみました。

ユーザーフォームで独自Msgboxをモーダレスで作成する方法です。

新規ブックにユーザーフォーム（UserForm1）のみを作成してください。
コントロールはコードで作成しますから、配置しないで下さい。

上記の何もコントロールが配置されていないUserForm1のモジュールに

'==================================================================
Option Explicit
Private sidx As Long
Private sobj() As Object
Private t_obj As Object
Private WithEvents 削除 As MSForms.CommandButton
Private WithEvents 次の図形 As MSForms.CommandButton
'==================================================================
Private Sub UserForm_Initialize()
　　With Me
　　　 .Width = 189
　　　 .Height = 75
　　　 Set 削除 = .Controls.Add("Forms.CommandButton.1", , True)
　　　 With 削除
　　　　　.Caption = "削除"
　　　　　.Left = 24
　　　　　.Top = 18
　　　　　.Width = 60
　　　　　.Height = 18
　　　　　End With
　　　 Set 次の図形 = .Controls.Add("Forms.CommandButton.1", , True)
　　　 With 次の図形
　　　　　.Caption = "次の図形"
　　　　　.Left = 96
　　　　　.Top = 18
　　　　　.Width = 60
　　　　　.Height = 18
　　　　　End With
　　　 End With
　　Call open_sobj(ActiveSheet)
　　Call set_obj
End Sub
'==================================================================
Sub open_sobj(ByVal sht As Worksheet)
　　Dim obj As Object
　　If sht.Shapes.Count > 0 Then
　　　 ReDim sobj(1 To sht.Shapes.Count)
　　　 sidx = 1
　　　 For Each obj In sht.Shapes
　　　　　Set sobj(sidx) = obj
　　　　　sidx = sidx + 1
　　　　　Next
　　　 sidx = 1
　　　 End If
End Sub
'==================================================================
Function get_sobj() As Object
　　Set get_sobj = Nothing
　　If sidx <= UBound(sobj()) Then
　　　 Set get_sobj = sobj(sidx)
　　　 sidx = sidx + 1
　　　 End If
　　　
End Function
'==================================================================
Sub close_sobj()
　　Erase sobj()
　　sidx = 0
End Sub
'==================================================================
Function set_obj() As Long
　　On Error Resume Next
　　set_obj = 0
　　Do
　　　Set t_obj = get_sobj()
　　　If Not t_obj Is Nothing Then
　　　　 Err.Clear
　　　　 t_obj.Select
　　　　 If Err.Number = 0 Then Exit Do
　　　　 Err.Clear
　　　　 t_obj.Visible = True '非表示図形を表示
　　　　 t_obj.Select
　　　　 If Err.Number = 0 Then Exit Do
　　　Else
　　　　 MsgBox "end"
　　　　 set_obj = 1
　　　　 Exit Do
　　　　 End If
　　　Loop
End Function
'==================================================================
Private Sub UserForm_Terminate()
　　Call close_sobj
　　Set t_obj = Nothing
End Sub
'==================================================================
Private Sub 削除_Click()
　　On Error Resume Next
　　t_obj.Delete
　　Call set_obj
End Sub
'==================================================================
Private Sub 次の図形_Click()
　　set_obj
End Sub

標準モジュールに
'====================================================================
Sub main()
　　UserForm1.Show vbModeless
End Sub

アクティブシートに適当に図形を配置した後、mainを実行して試してみてください。

excel2002では、それらしく作動しています。

前回投稿との変更点

当初、Drawingobjectsコレクションで処理することしか頭にはありませんでした。
（入力規則のリストやオートフィルタの↓図形まで削除対象になることを考慮した
つもりだったのですが・・・）

Drawingobjectだとコネクタが選択できない
グループ化された図形の扱いが面倒　の問題が発生し、再考。

結局　Shapesコレクションで処理することで再送しました。
Select時のエラーで、入力規則のリストやオートフィルタの↓図形は、ここでカットされるので、問題なしと判断しました。

尚、コード等で非表示にしてある図形も表示して選択する仕様にしました。

試してみてください


	【54683】Re:オブジェクトを選択状態でmsgbox表示

VBWASURETA - 08/3/26(水) 9:14 -


	引用なし

	パスワード

皆さんおはようございます。

試しにjakaさんのやってみました。
一定で表示非表示の描画でどれが選択されているか
この方法でわかりますね。

ichinoseさんのも試しましたが、
すみませんExcelのバージョンで動きが違うようです・・・

Excel2000だと選択、削除されずに終了するようです。


	【54686】Re:オブジェクトを選択状態でmsgbox表示

ichinose - 08/3/26(水) 10:30 -


	引用なし

	パスワード

▼VBWASURETA さん：
おはようございます。
>ichinoseさんのも試しましたが、
>すみませんExcelのバージョンで動きが違うようです・・・
>Excel2000だと選択、削除されずに終了するようです。

win2000　Excel2000sp3でも確認しましたが、

Sub Macro1()
　　ActiveSheet.Shapes.AddLine(126.75, 276.75, 212.25, 286.5).Select
　　ActiveSheet.Shapes.AddShape(msoShapeRectangle, 369.75, 291#, 69.75, 47.25). _
　　　　Select
　　ActiveSheet.Shapes.AddShape(msoShapeOval, 338.25, 175.5, 39.75, 24#).Select
End Sub

こんなサンプルデータで正しく作動していますが、
テスト不足なので違うパターンでしたら教えてください。


	【54688】Re:オブジェクトを選択状態でmsgbox表示

VBWASURETA - 08/3/26(水) 12:02 -


	引用なし

	パスワード

▼ichinose さん：
おはようございます。

>win2000　Excel2000sp3でも確認しましたが、
>
>Sub Macro1()
>　　ActiveSheet.Shapes.AddLine(126.75, 276.75, 212.25, 286.5).Select
>　　ActiveSheet.Shapes.AddShape(msoShapeRectangle, 369.75, 291#, 69.75, 47.25). _
>　　　　Select
>　　ActiveSheet.Shapes.AddShape(msoShapeOval, 338.25, 175.5, 39.75, 24#).Select
>End Sub
>
>こんなサンプルデータで正しく作動していますが、
>テスト不足なので違うパターンでしたら教えてください。

テストしたのは、先に複数オートシェイプをシートに貼り付けて
Mainをコールしました。

後、環境ですが、

OS：XP Pro SP2

Excel：2002 SP3 ※すみませんこちらバージョン間違えてました＾＾；


	【54689】Re:オブジェクトを選択状態でmsgbox表示

ichinose - 08/3/26(水) 12:38 -


	引用なし

	パスワード

▼VBWASURETA さん：

>
>>win2000　Excel2000sp3でも確認しましたが、
>>
>>Sub Macro1()
>>　　ActiveSheet.Shapes.AddLine(126.75, 276.75, 212.25, 286.5).Select
>>　　ActiveSheet.Shapes.AddShape(msoShapeRectangle, 369.75, 291#, 69.75, 47.25). _
>>　　　　Select
>>　　ActiveSheet.Shapes.AddShape(msoShapeOval, 338.25, 175.5, 39.75, 24#).Select
>>End Sub
>>
>>こんなサンプルデータで正しく作動していますが、
>>テスト不足なので違うパターンでしたら教えてください。
>
>テストしたのは、先に複数オートシェイプをシートに貼り付けて
>Mainをコールしました。
>
>後、環境ですが、
>
>OS：XP Pro SP2
>
>Excel：2002 SP3 ※すみませんこちらバージョン間違えてました＾＾；

そうですか？検証ありがとうございます。

私のテスト環境は、Win2000　&Excel2002 SP3　です。

上記のようなコードで作成された図形は、確かに選択状態になり、
削除ボタンクリックで削除されます。

ＯＳの問題でしょうかねえ！！


	【54690】Re:オブジェクトを選択状態でmsgbox表示

VBWASURETA - 08/3/26(水) 12:56 -


	引用なし

	パスワード

▼ichinose さん：
ちょっとデバッグして見ました。

理由が一部わかったのですが、
> Private sobj() As Object

がNothingになるタイミングがあるようです。
後、次の図形_Clickメソッドを呼びながら削除_Click()
を呼び出していたのでどうも歯抜けになったようですね。
多分これが原因ですね。すみません。

因みにそいう感じになったので、

Function get_sobj() As Object
　　Set get_sobj = Nothing
　　If sidx <= UBound(sobj()) Then
　　　　Set get_sobj = sobj(sidx)
　　　　sidx = sidx + 1
　　Else
　　　　sidx = 1
　　End If
End Function

という感じに添え字クリアする部分入れてできるようになりました＾＾；
なので、環境ではなかったみたいです。すみません・・・


	【54701】Re:オブジェクトを選択状態でmsgbox表示

ichinose - 08/3/26(水) 17:32 -


	引用なし

	パスワード

▼VBWASURETA さん：
こんにちは。

>ちょっとデバッグして見ました。
>
>理由が一部わかったのですが、
>> Private sobj() As Object
>
>がNothingになるタイミングがあるようです。

なるほど、変数が初期化されてしまう現象は、否定できませんね！！

ActiveXコントロール削除の場合は、どうかな（sobj() がNothingになる）と思っていましたが・・。

でも、これは見付けづらい図形オブジェクトを見つける　のが目的なら、
運用は、アドインにするのが良さそうですよね！！

その場合は、ActiveXコントロール削除でも変数が初期化されないと思います。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

4763 / 13657 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free