Excel VBA質問箱 IV

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

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


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

【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 = "OK"
  CBB.OnAction = "'実行マクロ(1)'"
  Set CBB = Nothing
  
  Set CBB = Cbr.Controls.Add(msoControlButton)
  CBB.Style = msoButtonCaption
  CBB.Caption = "NO"
  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 です。

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

OSの問題でしょうかねえ!!

【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コントロール削除でも変数が初期化されないと思います。

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