Excel VBA質問箱 IV

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

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


9172 / 13644 ツリー ←次へ | 前へ→

【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 お礼[未読]

【28685】チェックボックスを含む行の追加
質問  toki  - 05/9/12(月) 21:27 -

引用なし
パスワード
   こんにちは。tokiと申します。よろしくお願いします。

現在、社員別の点数集計表を作成する予定でおります。
セルA1,B1,C1,D1という行においてA1(役職名)、B1(氏名)、C1(点数)、D1(チェックボックス)といった意味付けをしたいと思っております。
別途ユーザフォームにて新規追加用入力画面を作成し、こちらで、役職名と氏名を入力するとA1,B1,C1,D1が複製されていき、順じA2,B2,C2,D2という具合に行が下に追加されていくようなことはできるのでしょうか?
質問としては
1.ユーザフォームで入力した役職名、氏名が指定した行の下に順じ追加できるかということ
2.その場合、オブジェクトであるチェックボックスも同時に追加していけるか
という点です。
チェックボックスの利用方法はあとで、チェックした社員分のデータを別のシートに作成した帳票に反映させて順じ印刷させるようにしようと思っています。

素人的な質問で申し訳ございませんが初心者なもので何卒よろしくお願いいたします。

【28686】Re:チェックボックスを含む行の追加
発言  ichinose  - 05/9/12(月) 21:54 -

引用なし
パスワード
   ▼toki さん:
こんばんは。

>現在、社員別の点数集計表を作成する予定でおります。
>セルA1,B1,C1,D1という行においてA1(役職名)、B1(氏名)、C1(点数)、D1(チェックボックス)といった意味付けをしたいと思っております。
>別途ユーザフォームにて新規追加用入力画面を作成し、こちらで、役職名と氏名を入力するとA1,B1,C1,D1が複製されていき、順じA2,B2,C2,D2という具合に行が下に追加されていくようなことはできるのでしょうか?


>質問としては
>1.ユーザフォームで入力した役職名、氏名が指定した行の下に順じ追加できるかということ
例えば、シート名が"点数集計表"だとします。
氏名は、必須入力だとすれば、
データ追加行は以下のようにすると取得出来ます。
ENDプロパティを調べてみて下さい。

Sub test()
  With Worksheets("点数集計表")
    MsgBox .Cells(.Rows.Count, 2).End(xlUp).Row + 1
    End With
End Sub

>2.その場合、オブジェクトであるチェックボックスも同時に追加していけるか
>という点です。
出来ないことはありません・・・が、
オブジェクトを増やしていくということは、非常に重くなってしまいます。
ユーザーフォームのチェックボックスから
TrueかFalseというデータのみを追加していくという方法で

>チェックボックスの利用方法はあとで、チェックした社員分のデータを別のシートに作成した帳票に反映させて順じ印刷させるようにしようと思っています。

↑これが目的なら事足りると思いますが、いかがですか?

【28687】Re:チェックボックスを含む行の追加
質問  toki  - 05/9/12(月) 22:43 -

引用なし
パスワード
   ▼ichinose さん:
早速のご教示ありがとうございます!

>>質問としては
>>1.ユーザフォームで入力した役職名、氏名が指定した行の下に順じ追加できるかということ
>例えば、シート名が"点数集計表"だとします。
>氏名は、必須入力だとすれば、
>データ追加行は以下のようにすると取得出来ます。
>ENDプロパティを調べてみて下さい。
>
>Sub test()
>  With Worksheets("点数集計表")
>    MsgBox .Cells(.Rows.Count, 2).End(xlUp).Row + 1
>    End With
>End Sub

ありがとうございます。早速試してみます!

>>2.その場合、オブジェクトであるチェックボックスも同時に追加していけるか
>>という点です。
>出来ないことはありません・・・が、
>オブジェクトを増やしていくということは、非常に重くなってしまいます。
>ユーザーフォームのチェックボックスから
>TrueかFalseというデータのみを追加していくという方法で
>
>>チェックボックスの利用方法はあとで、チェックした社員分のデータを別のシートに作成した帳票に反映させて順じ印刷させるようにしようと思っています。
>
>↑これが目的なら事足りると思いますが、いかがですか?

運用としては、ユーザーフォームで社員登録するタイミングと社員リストから印刷する社員を選ぶタイミングが別になるため、登録後、ユーザーが社員を選択のうえ印刷という形をとりたかったのです。セルにデータを入れてフラグを立てることも考えましたができるだけマウス操作でやりたかったので。

【28689】Re:チェックボックスを含む行の追加
発言  ponpon  - 05/9/12(月) 23:36 -

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

一応作ってみました。

ユーザーフォームに
 TextBox1・・・役職入力用
 TextBox2・・・氏名入力用
 CommandButton1・・・マクロ実行用
を用意してください。

シートは、シート名「点数集計表」

一行目にA列に「役職」
    B列に「氏名」
    C列に「点数」
    D列に「チェック」が入力済みと仮定します。

いつもお世話になっているichinoseさんから
>出来ないことはありません・・・が、
>オブジェクトを増やしていくということは、非常に重くなってしまいます。
>ユーザーフォームのチェックボックスから
>TrueかFalseというデータのみを追加していくという方法で

という忠告がでていますが、
D列にチェックボックス(フォームの)が張り付くようにしています。
都合が悪ければ、ユーザーフォームにチェックボックスを設け、その結果のみを
転記するように変更してください。

同姓同名などの問題点は残していますが、入力なしと氏名の二重登録のチェックは
考えてみました。

参考にということで試してみてください。

Private Sub CommandButton1_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
  
  If Me.TextBox1.Text = "" Or Me.TextBox2.Text = "" Then
   MsgBox "役職、氏名を入力してください。"
  Else
  With Worksheets("点数集計表")
   A = Application.Match(Me.TextBox2.Text, .Range("B:B"), 0)
   If Not IsError(A) Then
    MsgBox "この人は登録済みです。"
    Exit Sub
   End If
     With .Range("A65536").End(xlUp)
      .Offset(1, 0).Value = Me.TextBox1.Text
      .Offset(1, 1).Value = Me.TextBox2.Text
      Set myR = .Offset(1, 3)
       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
  End If
End Sub

【28696】Re:チェックボックスを含む行の追加
発言  ichinose  - 05/9/13(火) 7:23 -

引用なし
パスワード
   toki さん、ponpon さん
おはようございます。

>運用としては、ユーザーフォームで社員登録するタイミングと社員リストから印刷する社員を選ぶタイミングが別になるため、登録後、ユーザーが社員を選択のうえ印刷という形をとりたかったのです。セルにデータを入れてフラグを立てることも考えましたができるだけマウス操作でやりたかったので。

だとしたら、方法もあります。
シートには BeforeDoubleClickイベントなんてのもありますから。

新規ブックにて

任意のシートモジュールに
'=======================================
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Const 印刷 = "印刷します"
  Const NO印刷 = "印刷しないよ"
  With Target
   If .Value = "" Or .Value = NO印刷 Then
     .Value = 印刷
   Else
     .Value = NO印刷
     End If
   End With
  Cancel = True
End Sub

として、当該シートで

任意のセルをダブルクリックしてみて下さい。

一例にすぎませんが、こんな方法もあります。
ponpon さんがコードを提示されているので
参考意見として検討してみて下さい

【28699】Re:チェックボックスを含む行の追加
お礼  toki  - 05/9/13(火) 8:45 -

引用なし
パスワード
   ▼ponpon さん:
お世話になります。ご回答ありがとうございます!

こんなにご丁寧な回答をいただき感激です。
早速試してみたいと思います!
ありがとうございました!!!

【28700】Re:チェックボックスを含む行の追加
お礼  toki  - 05/9/13(火) 8:46 -

引用なし
パスワード
   ▼ichinose さん:

ご丁寧にありがとうございます!!

早速試してみます。

今後とも宜しくお願いいたします!

【28722】Re:チェックボックスを含む行の追加
質問  toki  - 05/9/13(火) 16:19 -

引用なし
パスワード
   ▼ponpon さん:

こんにちは。ponpon様に教えていただいたものを元に作ってみました。
1.ユーザーフォームは入力を3つとしました。
・職務(コンボボックス)
・社員名(テキストボックス)
・社員番号(テキストボックス)
2.C列を社員番号としました。
3.チェックボックスはT列に配置しました。

結果、ほとんど私の理想どおりの形となりました。ありがとうございます!

しかし、私がいじったところがうまく動きません。
2重登録の防止のところなのですが、C列の社員番号にも適用しようと思い書き加えました。
しかし、ひっかかってくれません。
下のソースのどこがおかしいのでしょうか?

Private Sub CommandButton1_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
 
  If Me.社員登録ComboBox1 = "" Then
   MsgBox "職務を入力してください。"
  ElseIf Me.社員名TextBox1 = "" Then
   MsgBox "社員名を入力してください。"
  ElseIf Me.社員番号TextBox1 = "" Then
   MsgBox "社員番号を入力してください。"
  
  Else
  
  With Worksheets("管理者入力画面")
   A = Application.Match(Me.社員名TextBox1.Text, .Range("B:B"), 0)
   B = Application.Match(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, 19)
       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
  End If
  
End Sub

あともうひとつご質問があります。こうして作られたものを社員リストから社員を行ごと削除したい場合があります。
このとき、削除用のユーザーフォームを作り、社員番号を入れると、検索して名前が表示され、コマンドボタンで行ごと削除する、という方法はとれますでしょうか?
チェックボックスも一緒に消したいのですが。

【28736】Re:チェックボックスを含む行の追加
発言  ponpon  - 05/9/13(火) 20:24 -

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

社員番号は、数値ですか?
それなら、

>B = Application.Match(Me.社員番号TextBox1.Text, .Range("C:C"), 0)



B = Application.Match(Val(Me.社員番号TextBox1.Text), .Range("C:C"), 0)

としたらいかがでしょう。

私には、よく分かりませんが、セルの値が数値の場合、
TextBoxは、文字通りTextですから、型が違ってエラーとなるのだと思います。
セルに書き出したときは、エクセルが自動的に数値に変換してくれますが、
そのまま参照した場合、Textのままではないでしょうか。
詳しくは、上級者の回答をお待ちください。

【28746】Re:チェックボックスを含む行の追加
お礼  toki  - 05/9/13(火) 22:07 -

引用なし
パスワード
   ▼ponpon さん:
>こんばんは。
>
>社員番号は、数値ですか?
>それなら、
>
>>B = Application.Match(Me.社員番号TextBox1.Text, .Range("C:C"), 0)
>
>を
>
>B = Application.Match(Val(Me.社員番号TextBox1.Text), .Range("C:C"), 0)
>
>としたらいかがでしょう。
>

ponponさんありがとうございます!
うまくいきました!
今後ともよろしくお願いします。

【28756】Re:チェックボックスを含む行の追加
発言  ponpon  - 05/9/13(火) 23:32 -

引用なし
パスワード
   こんばんは。
削除する場合ですが、新しくユーザーフォームを作るのではなく、
今あるユーザーフォームに削除用コマンドボタン2を設け、
それをクリックしたら、削除するようにしたらいかがでしょうか?

試していませんが、以下のようなコードでできると思います。
もっといい方法があるかもしれません。

Private Sub CommandButton2_Click()
 Dim myRow As Long
 Dim ans As Variant
 
 With Worksheets("点数集計表")
  myRow = Application.Match(Val(Me.社員番号TextBox1.Text), .Range("C:C"), 0)
  If Not IsError(myRow) Then
   Me.社員名TextBox1.Text = .Cells(myRow, "C").Offset(0, -1).Value
'   Me.社員登録ComboBox1.Value = .Cells(myRow, "C").Offset(0, -2).Value
   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, 17).Top = chcB.Top Then
      chcB.Delete
     End If
     Next
    Else
    Exit Sub
    End If
  Else
   MsgBox "この社員番号は登録されていません"
  End If
 End With


End Sub

【28757】Re:チェックボックスを含む行の追加
質問  toki  - 05/9/13(火) 23:52 -

引用なし
パスワード
   ▼ponpon さん:

本当に助かります。ありがとうございました!

お預かりしたソースを改造して使ってみましたところうまくいきました。
一応、別フォームに検索ボタンと削除用の画面を作り、番号検索をして確認した後、削除という段取りでやりました。

ところで、別の問題があります。

現在、入力しようとしているシートと同じ書式のシートが13枚あります。
残りの13枚にも同様に行追加したいのですが、この場合、ponponさんの下記コードを13個追加しなくてはならないでしょうか?

    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, 19)
       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 = "チェック"

実際にシート”1月”に行追加する場合
    With worksheets("1月").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, 19)
       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 = "チェック"

を上記コードの下に追加すると、1月のシートにも行が追加されますが、チェックボックス部分が追加されなくなります。
1.複数のシートに展開する場合、ワークシートを配列のように使うことはできるのでしょうか?
2.上記のようにした場合チェックボックスだけ1月シートに展開されないのは構文の問題でしょうか?

よろしくお願いします。

【28758】Re:チェックボックスを含む行の追加
発言  ponpon  - 05/9/14(水) 0:44 -

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

>実際にシート”1月”に行追加する場合
    With worksheets("1月")
     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, 19)
       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

ですね。
 With節がどこまでなのかを考えないとミスります。
  .Offsetは、worksheets("1月").Range("A65536").End(xlUp)の省略で、
  .CheckBoxes.Add(myLeft, myTop, myWidth, myHeight)は、worksheets("1月")
の省略です。


ブックにあるすべてのシートに書き込むなら
With Worksheets("管理者入力画面")
End With
を削除して、その代わりに

  Application.ScreenUpdating = False
  For Each sh In ThisWorkbook.Worksheets
   With sh  

  ’処理

   End With
  Next
 Application.ScreenUpdating = True

とすればよいでしょう。
シート名が「1月」から「12月」なら(大文字小文字に注意)
For i = 1 To 12
 With WorkSheets( i & "月")

'処理

 End With
Next

で処理できると思います。

【28763】Re:チェックボックスを含む行の追加
お礼  toki  - 05/9/14(水) 9:18 -

引用なし
パスワード
   ▼ponpon さん:
ponponさんこんにちは。

いつもありがとうございます!
うまくいきました!

本当に助かります。
今後ともよろしくお願いします。
どうもありがとうございました!

【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

【28938】Re:チェックボックスを含む行の追加
発言  ponpon  - 05/9/18(日) 23:48 -

引用なし
パスワード
   こんばんは。
これは、試してなかったのですが、試してみるとうまくいったように見えて
ダメですね。申し訳ありません。

行より先に、チェックボックスを削除するようにしてもダメみたいです。
その行のチェックボックスが取得できていないようです。

ちょっと考えてみます。

【28939】Re:チェックボックスを含む行の追加
発言  Hirofumi  - 05/9/19(月) 0:35 -

引用なし
パスワード
   {28929}Sortメソッド の方で回答したHirofumiです
善く見て居ないので野次馬で申し訳有りませんが?
ichinoseさんも回答している様に、
私も、各行にチェックボクッスを付けるのは、上手く無い様な気がします

理由として
1、Bookが重くなる
2、追加、削除でも特別なコードが必要
3、WorkSheetの行との連動は如何するの?
 整列、抽出、探索で別に処理しなければ成らない
 出来るのかすら怪しいし、出来ても面倒そう?
等々

だとしたら、其の列に入力規則を設定して、リスト入力で「*」等を入れるか、入れないか
とした方が後々楽なような気がします

【28941】Re:チェックボックスを含む行の追加
発言  ponpon  - 05/9/19(月) 1:02 -

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

一応考えてみましたが、これでうまくいくように見えますが、もしダメなら
仕様を変更することをお勧めします。印刷用のチェックなら、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

【28942】Re:チェックボックスを含む行の追加
発言  ponpon  - 05/9/19(月) 1:08 -

引用なし
パスワード
   こんばんは。
hirohumiさんからもアドバイスがあるように仕様を変更されたらいかがでしょうか?

チェックボックスの部分だけを削除するだけでいいし、前にも書きましたが、印刷や
抽出用のチェックなら他の仕様の方が、オートフィルター等が使えて、後々使い勝手が
よいと思います。

【28945】Re:チェックボックスを含む行の追加
お礼  toki  - 05/9/19(月) 10:04 -

引用なし
パスワード
   ▼Hirofumi さん:

なるほど。やはり仕様変更した方がよさそうですね。
とても参考になりました。ありがとうございました!

【28946】Re:チェックボックスを含む行の追加
お礼  toki  - 05/9/19(月) 10:15 -

引用なし
パスワード
   ▼ponpon さん:
>こんばんは。
>hirohumiさんからもアドバイスがあるように仕様を変更されたらいかがでしょうか?
>
>チェックボックスの部分だけを削除するだけでいいし、前にも書きましたが、印刷や
>抽出用のチェックなら他の仕様の方が、オートフィルター等が使えて、後々使い勝手が
>よいと思います。

上級者の皆様のご意見に従い、仕様変更を検討したいと思います!
今後ともよろしくお願いいたします。
貴重なご意見ありがとうございました!

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