| |
こんばんは。
一応考えてみましたが、これでうまくいくように見えますが、もしダメなら
仕様を変更することをお勧めします。印刷用のチェックなら、ichinoseさん
からも案が出ています。
チェックボックスを特定するために、以下のように修正してください。
チェックボックスに社員番号を追加し、特定します。
>////////////////////////////////////////////////////
>登録ボタン処理内容
>ユーザーフォーム上のコマンドボタンで入力項目を入力すると
>各シートに反映されます。
>
>各シートは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 = StrConv(Me.TextBox1.Text, vbNarrow) ’★
> 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
For Each chcB In .CheckBoxes
If chcB.Characters.Text = .Cells(myRow, "C").Text Then
chcB.Delete
End If
Next
.Cells(A, "B").EntireRow.Delete shift:=xlUp
> 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
|
|
ponpon
- 05/9/19(月) 1:02 -
