Excel VBA質問箱 IV

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

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


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

【43510】ワークシート上のチェックボックス ゆう 06/10/18(水) 14:29 質問[未読]
【43519】Re:ワークシート上のチェックボックス Jaka 06/10/18(水) 17:23 発言[未読]
【43532】Re:ワークシート上のチェックボックス bykin 06/10/18(水) 22:37 回答[未読]
【43543】Re:ワークシート上のチェックボックス ゆう 06/10/19(木) 9:13 お礼[未読]
【43546】Re:ワークシート上のチェックボックス Jaka 06/10/19(木) 9:43 発言[未読]

【43510】ワークシート上のチェックボックス
質問  ゆう  - 06/10/18(水) 14:29 -

引用なし
パスワード
   いつもお世話になってます。

出来るかどうかもわからないのですが、
1.ワークシート上(仮に1行目)にチェックボックスがあります。
 これを1行目を削除した時に一緒に削除することは可能ですか?
 ワークシート上の全てのチェックボックスを削除するのは
 分かったのですが、消した行の上にあるチェックボックスだけって
 どう削除するのでしょうか?

もう一つ同じようなことなのですが、
2.例えば1行目のA列にあるチェックボックスのアドレスをB列に
 していたとして、この1行目をコピーした時2行目のチェックボックスの
 アドレスは2行目のB列にすることは可能でしょうか?

1.2.ともChengeイベントにて処理できたらいいなぁと思っているのですが、
アドバイスお願いします。

【43519】Re:ワークシート上のチェックボックス
発言  Jaka  - 06/10/18(水) 17:23 -

引用なし
パスワード
   挿入に対応してないし、他の方法はわかりません。

Private Sub Worksheet_Calculate()
If Range("A1").Value <> 65536 Then
  Range("最後のセル").Cut Range("A65536")
  Rw = Selection.Row
  MsgBox Selection.Row & "が、多分削除"
  Call Shapdel(Rw)
End If
End Sub

Sub Shapdel(Rw)
Dim Shp As Shape
If ActiveSheet.Shapes.Count > 0 Then
  For Each Shp In ActiveSheet.Shapes
    Set RW1 = Application.Intersect(Rows(Rw), Shp.TopLeftCell)
    Set RW2 = Application.Intersect(Rows(Rw), Shp.BottomRightCell)
    If Not (RW1 Is Nothing) And Not (RW2 Is Nothing) Then
     MsgBox "図形?の名前 " & Shp.Name
    End If
  Next
End If
End Sub

準備として65536行のどこかのセルの名前定義。
1行目のどこかのセルにイベント用の関数。
Sub 準備()
Worksheets(1).Range("A65536").Name = "最後のセル"
Range("A1").Formula = "=ROW(最後のセル)"
End Sub

これら名前定義したセル、関数を入れたセルが削除されたら動きません。
また、他の不具合があることは考えてません。(他の不具合が無いと思えないけど。)

【43532】Re:ワークシート上のチェックボックス
回答  bykin  - 06/10/18(水) 22:37 -

引用なし
パスワード
   こんばんわ。

最初のご質問はChangeイベントってのは行の削除や挿入以外に、セルのデータを
変更したときにも起動されるイベントやから、完璧にはできへんと思うよ。
一応考えてみたけど、セルをフィルドラッグした場合なんかが、標準の動きと
違ってまいます。
他にも不具合が隠れてる可能性めっちゃ大です。
イベントがしょっちゅう起動するのも鬱陶しいし。
参考程度でっけど・・・

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Cnt As New Collection
  Dim Ad1 As String
  Dim Ad2 As String
  Dim Chk As CheckBox
  Dim Buf As Variant
  Dim i As Long
  
  On Error GoTo Error_Handler
  If Target.Areas.Count > 1 Then Exit Sub
  If ActiveSheet.CheckBoxes.Count = 0 Then Exit Sub
  Buf = Target.Formula
  Ad1 = Target.Address
  Application.EnableEvents = False
  Application.Undo
  On Error Resume Next
  Ad2 = Target.Address
  If Err.Number = 0 Then
    On Error GoTo Error_Handler
    If Ad1 <> Ad2 Then
      For Each Chk In ActiveSheet.CheckBoxes
        Cnt.Add Array(Chk.TopLeftCell.EntireRow.Address, _
               Chk.BottomRightCell.EntireRow.Address, _
               Chk.Name)
      Next
      Application.Repeat
      For i = 1 To Cnt.Count
        If Not Intersect(Range(Cnt(i)(0)), Target) Is Nothing Then
          If Not Intersect(Range(Cnt(i)(1)), Target) Is Nothing Then
            ActiveSheet.CheckBoxes(Cnt(i)(2)).Delete
          End If
        End If
      Next
    Else
      Target.Formula = Buf
      Target.Select
      If Application.MoveAfterReturn Then
        SendKeys "{Enter}"
      End If
    End If
  Else
    Application.Repeat
  End If

Error_Handler:
  Set Cnt = Nothing
  Application.EnableEvents = True
End Sub

やっぱりイベント使うより、行の削除自体をマクロで行うほうがええと思います。
チェック項目も少ないからコードも短くて済むし。
たとえば・・・

Sub test()
  Dim Rng As Range
  Dim Chk As CheckBox
  Dim Cnt As New Collection
  Dim i As Long
  
  If Selection.Address <> Selection.EntireRow.Address Then Exit Sub
  For Each Rng In Selection.Areas
    For Each Chk In ActiveSheet.CheckBoxes
      If Not Intersect(Chk.TopLeftCell, Rng) Is Nothing Then
        If Not Intersect(Chk.TopLeftCell, Rng) Is Nothing Then
          Cnt.Add Chk
        End If
      End If
    Next
  Next
  On Error Resume Next
  Selection.Delete
  If Err.Number = 0 Then
    For i = 1 To Cnt.Count
      Cnt(i).Delete
    Next
  Else
    MsgBox "選択範囲が重複しています", vbExclamation
  End If
  Set Cnt = Nothing
End Sub


次のご質問は難しいねー
コピーしたってイベント発生するわけやなし・・・
コピー先がどこになるかなんて操作してる本人にしかわからんしねー

イベントやない通常のマクロで、全部のチェックボックスを順番に調べて、
A列にあったら同じ行のB列のセルにリンク先を「再設定」する・・・
くらいしかできへんのとちゃうかな?
リンク先の設定はマクロの自動記録を使えばわかると思います。

ほな。

【43543】Re:ワークシート上のチェックボックス
お礼  ゆう  - 06/10/19(木) 9:13 -

引用なし
パスワード
   Jakaさん、bykinさんへ

回答ありがとうございます。
お二人の回答を見て、かなり難しいことに気づきました。
回答を参考にさせて頂き、もう一度
いろいろ考えてみようと思います。
お二人のプログラムを見てすごいなぁと思う反面、
私もまだまだだなぁと反省しました。
もっと頭を柔軟にして考えられるように努力したいと思います。
本当にありがとうございました。
また何かあれば、よろしくお願いします。

【43546】Re:ワークシート上のチェックボックス
発言  Jaka  - 06/10/19(木) 9:43 -

引用なし
パスワード
   ▼ゆう さん:
>お二人のプログラムを見てすごいなぁと思う反面、
いえ、昨日は帰ることにいっぱいいっぱいだったので書き忘れちゃったけど、
私のコードは、常連回答者りんさんのパクリです。
(パクリというより、そのまんまといったほうが良いかのコードが混ざってます。)
りんさん、ごめんなさい。

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