Excel VBA質問箱 IV

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

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


52630 / 76732 ←次へ | 前へ→

【28937】Re:チェックボックスを含む行の追加
質問  toki  - 05/9/18(日) 22:59 -

引用なし
パスワード
   こんにちは。tokiです。

大変申し訳ないのですが、ponponさんに教えていただいたコードを元に作成したプログラムが正常に動作しないことがわかりました。

私の改造の仕方が悪いと思うので教えてください。

現象としては、下記登録ボタンにて登録したものを、下記削除ボタンにて削除するとき、抽出した行そのものは削除できるのですが、チェックボックス削除がうまくいきません。
具体的には、削除した行の下の行がSHIFTUPしたときにその行のチェックボックスが消えたりします。

ためしに削除コマンドから
For Each chcB In .CheckBoxes
   If Cells(myRow, "C").Offset(0, 23).Top = chcB.Top Then
   chcB.Delete
   End If
Next  

を消して処理してみると、一見うまくいったかに見えるのですが、全部消していって最後の1行も消したときに、チェックボックスが
ひとつだけ残ってしまいます。

チェックボックスオブジェクトの扱いがよくわからないので解析できないでいます。

ご教示よろしくお願いいたします。


////////////////////////////////////////////////////
登録ボタン処理内容
ユーザーフォーム上のコマンドボタンで入力項目を入力すると
各シートに反映されます。

各シートはA列職務、B列社員名、C列社員番号です。
上期シートのチェックボックスはX列です。

////////////////////////////////////////////////////
Private Sub 登録ボタン_Click()
  
  Dim myR As Range
  Dim chcB As Object
  Dim myLeft As Single, myTop As Single
  Dim myWidth As Single, myHeight As Single
  Dim A As Variant
  Dim B As Variant
  Dim i As Integer
 
  If Me.社員番号TextBox1 = "" Then
   MsgBox "社員番号を入力してください。"
  ElseIf Me.社員名TextBox1 = "" Then
   MsgBox "社員名を入力してください。"
  ElseIf Me.社員登録ComboBox1 = "" Then
   MsgBox "職務を入力してください。"
  
  Else
  
  '上期に登録
  With Worksheets("上期")
   A = Application.Match(Me.社員名TextBox1.Text, .Range("B:B"), 0)
   B = Application.Match(Val(Me.社員番号TextBox1.Text), .Range("C:C"), 0)
  
   If Not IsError(A) Then
    MsgBox "この人は登録済みです。"
    Exit Sub
   ElseIf Not IsError(B) Then
    MsgBox "この社員番号は登録済みです。"
    Exit Sub
   End If

    With .Range("A65536").End(xlUp)
      .Offset(1, 0).Value = Me.社員登録ComboBox1.Text
      .Offset(1, 1).Value = Me.社員名TextBox1.Text
      .Offset(1, 2).Value = Me.社員番号TextBox1.Text
      Set myR = .Offset(1, 23)
       myTop = myR.Top
       myLeft = myR.Left
       myWidth = myR.Width
       myHeight = myR.Height
    End With
    Set chcB = .CheckBoxes.Add(myLeft, myTop, myWidth, myHeight)
       chcB.Characters.Text = "チェック"
   End With
  
     
   'マ集計各月に登録
   For i = 1 To 12
   With Worksheets(i & "月")
   A = Application.Match(Me.社員名TextBox1.Text, .Range("B:B"), 0)
   B = Application.Match(Val(Me.社員番号TextBox1.Text), .Range("C:C"), 0)
  
   If Not IsError(A) Then
    MsgBox "この人は登録済みです。"
    Exit Sub
   ElseIf Not IsError(B) Then
    MsgBox "この社員番号は登録済みです。"
    Exit Sub
   End If

    With .Range("A65536").End(xlUp)
      .Offset(1, 0).Value = Me.社員登録ComboBox1.Text
      .Offset(1, 1).Value = Me.社員名TextBox1.Text
      .Offset(1, 2).Value = Me.社員番号TextBox1.Text
    End With
   End With
   Next
       
   Me.社員番号TextBox1 = ""
   Me.社員名TextBox1 = ""
   Me.社員登録ComboBox1 = ""
   
  End If
  
End Sub

//////////////////////////////////////////////////////////////////
削除ボタン処理内容
ユーザーフォーム上の削除ボタンで、入力された検索番号(=社員番号)に
相当する各シートの行を削除します。

/////////////////////////////////////////////////////////////////

Private Sub 削除ボタン_Click()
  
  Dim myRow As Variant
  Dim myRowtsuki As Variant
  Dim ans As Variant
  Dim i As Integer
   
   If Me.検索番号TextBox1.Text = "" Then
    MsgBox "検索番号を入力してください。"
   Else
   With Worksheets("上期")
    myRow = Application.Match(Val(Me.検索番号TextBox1.Text), .Range("C:C"), 0)
     If IsError(myRow) Then
      MsgBox "既に削除されています。"
      検索番号TextBox1.Text = ""
      Exit Sub
     End If
    ans = MsgBox("削除してもよいですか?", vbYesNo)
    If ans = vbYes Then
      
      .Cells(myRow, "C").EntireRow.Delete shift:=xlUp
      For Each chcB In .CheckBoxes
       If Cells(myRow, "C").Offset(0, 23).Top = chcB.Top Then
         chcB.Delete
       End If
      Next      
           
      For i = 1 To 12
       With Worksheets(i & "月")
       myRowtsuki = Application.Match(Val(Me.検索番号TextBox1.Text), .Range("C:C"), 0)
       .Cells(myRowtsuki, "C").EntireRow.Delete shift:=xlUp
       End With
      Next
      
      検索番号TextBox1.Text = ""
      検索社員名TextBox1.Text = ""
      検索現行職務TextBox1.Text = ""

      Else
      Exit Sub
    End If
   
   End With
   End If
 
End Sub
0 hits

【28685】チェックボックスを含む行の追加 toki 05/9/12(月) 21:27 質問
【28686】Re:チェックボックスを含む行の追加 ichinose 05/9/12(月) 21:54 発言
【28687】Re:チェックボックスを含む行の追加 toki 05/9/12(月) 22:43 質問
【28689】Re:チェックボックスを含む行の追加 ponpon 05/9/12(月) 23:36 発言
【28699】Re:チェックボックスを含む行の追加 toki 05/9/13(火) 8:45 お礼
【28722】Re:チェックボックスを含む行の追加 toki 05/9/13(火) 16:19 質問
【28736】Re:チェックボックスを含む行の追加 ponpon 05/9/13(火) 20:24 発言
【28746】Re:チェックボックスを含む行の追加 toki 05/9/13(火) 22:07 お礼
【28756】Re:チェックボックスを含む行の追加 ponpon 05/9/13(火) 23:32 発言
【28757】Re:チェックボックスを含む行の追加 toki 05/9/13(火) 23:52 質問
【28758】Re:チェックボックスを含む行の追加 ponpon 05/9/14(水) 0:44 発言
【28763】Re:チェックボックスを含む行の追加 toki 05/9/14(水) 9:18 お礼
【28937】Re:チェックボックスを含む行の追加 toki 05/9/18(日) 22:59 質問
【28938】Re:チェックボックスを含む行の追加 ponpon 05/9/18(日) 23:48 発言
【28939】Re:チェックボックスを含む行の追加 Hirofumi 05/9/19(月) 0:35 発言
【28945】Re:チェックボックスを含む行の追加 toki 05/9/19(月) 10:04 お礼
【28941】Re:チェックボックスを含む行の追加 ponpon 05/9/19(月) 1:02 発言
【28942】Re:チェックボックスを含む行の追加 ponpon 05/9/19(月) 1:08 発言
【28946】Re:チェックボックスを含む行の追加 toki 05/9/19(月) 10:15 お礼
【28696】Re:チェックボックスを含む行の追加 ichinose 05/9/13(火) 7:23 発言
【28700】Re:チェックボックスを含む行の追加 toki 05/9/13(火) 8:46 お礼

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