| |
こんにちは。tokiです。
大変申し訳ないのですが、ponponさんに教えていただいたコードを元に作成したプログラムが正常に動作しないことがわかりました。
私の改造の仕方が悪いと思うので教えてください。
現象としては、下記登録ボタンにて登録したものを、下記削除ボタンにて削除するとき、抽出した行そのものは削除できるのですが、チェックボックス削除がうまくいきません。
具体的には、削除した行の下の行がSHIFTUPしたときにその行のチェックボックスが消えたりします。
ためしに削除コマンドから
For Each chcB In .CheckBoxes
If Cells(myRow, "C").Offset(0, 23).Top = chcB.Top Then
chcB.Delete
End If
Next
を消して処理してみると、一見うまくいったかに見えるのですが、全部消していって最後の１行も消したときに、チェックボックスが
ひとつだけ残ってしまいます。
チェックボックスオブジェクトの扱いがよくわからないので解析できないでいます。
ご教示よろしくお願いいたします。
////////////////////////////////////////////////////
登録ボタン処理内容
ユーザーフォーム上のコマンドボタンで入力項目を入力すると
各シートに反映されます。
各シートは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
|
|
toki
- 05/9/18(日) 22:59 -
