[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『チェックボタンの利用 ？』（KonNo）
現在、Range("D2:D34")に「入力規制」で
「吹替、 」を指定しています。
該当セルをクリック
「吹替」又は「吹替なし」（空白＝スペース）から選択
該当セルをクリックするとチェックボタンが右隣に画面表示されて
チェックを入れると（ON）当該セルに「吹替」を書き込む
チェックを消すと（OFF) 当該セルに「 」（全角スペース）を書き込む
のように変更したいとの希望でした。
（書き込みが終了するとチェックボタンが画面から消える）
昨日教えてもらったchangeイベントが利用できそうですが
以下の
（チェックボックスが出現 ＞ 「吹替」、「 」 をセルに書き込む）
相当の処理コードが分かりません。
どのように考えたら良いでしょうか ？
（又、該当セルを修正する場合、
チェックON、OFFの状態を記録＝記憶する
必要も出てきそうで。。。）
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRNG As Range, bufRNG As Range
Set bufRNG = Intersect(Target, Range("D2:D34"))
（チェックボックスが出現 ＞ 「吹替」、「 」 をセルに書き込む）
End Sub
＜ 使用 Excel：Excel2019、使用 OS：Windows10 ＞
＞Renge("D2:D34")中を対象にターゲットセルに何か記入したら「吹替」と記入したい
どちらかの選択を求めているのであれば、
何かを入力したらなどというサービスは不要ではないですか？
・入力必須項目には塗りつぶし色をつける
・そのセルの近くに入力必須の旨をきちんと書く
ということではないんですか？
間違っていたら済みません。
（γ） 2021/09/29(水) 08:21
"吹替あり,吹替なし" という選択肢にすればよいのではないですか？
そうすると
対象セルに「吹替あり」「吹替なし」のいずれかが
全てのセルに文字が入力される事になります。
現在の「吹替」だけだと
直ぐに無しの全角スペースと見分けが付くので
あえて
「吹替あり」「吹替なし」と表示したくありません。
入力必須項目には塗りつぶし色をつける そのセルの近くに入力必須の旨をきちんと書く ということではないんですか？
おっしゃる事は正論で個人的には
現在のRange("D2:D34")に「入力規制」で十分で
説明文を書くことで他の人にも理解が出来ると思っていますが
一応、目上の人の依頼なので無下に「それは、無駄ですとは」
言えない、「大人の事情」がありまして。。。。
ご理解ください。
（KonNo） 2021/09/29(水) 08:45
・そうした選択肢がないので戸惑う、ということですか？
・それとも、スペースを選択した結果がわかりにくい、ということですか？
「大人の事情」ですか。
余計な忖度は、ことを複雑にするだけです。
事務方の誇りとして、正しい対応をされたらいかが？
（γ） 2021/09/29(水) 08:58
二択なら「BeforeDoubleClick」または「BeforeRightClick」を使ってみてはどうですか？
（もこな２） 2021/09/29(水) 09:20
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Range("D2:D34"), Target) Is Nothing Then Exit Sub
Cancel = True
If Target.Value = "吹替" Then
Target.ClearContents
Else
Target.Value = "吹替"
End If
End Sub
（もこな２） 2021/09/29(水) 09:27
「そうした選択肢がないので戸惑う」と言う意味です。
「入力規制」で 「吹替、 」なので
なしの場合は、カーソルで空白を選べば良いのですが
空白が表示されるだけ意味が伝わりにくいようです。
事務方の誇りとして、正しい対応をされたらいかが？
いやいや、会社員の話では無く
援助会的なサークルの相談内容です。
対応云々は、ここでのEXCELの相談とは話が違うので
追求しないでください。
オプションボタンを作ってはどうですか？
検討します。
もこな２さん、回答ありがとうございます。
「BeforeDoubleClick」または「BeforeRightClick」の利用を検討してみます。
（KonNo） 2021/09/29(水) 10:09
「BeforeDoubleClick」または「BeforeRightClick」の利用を検討してみます。
ターゲットのセル領域で
１)「BeforeDoubleClick」は、ダブルクリックで「吹替」と「 」が切り替わり
2)「BeforeRightClick」は、右クリックで「吹替」と「 」が切り替わる
ワークシートのセルに利用方法を記載しないとぱっと見た目だけでは
1),2)は理解が難しそうです。
最初の3)「入力規制」では、ターゲットセルをシングルクリックすると
下向きの矢印ボタン表示されるので注視されやすく
「吹替」と「 」を切り替えるのですが
３）と １）、２）を比較すると
１）、２）は、３）より選択時に難易度が上がってしまいました。
------------------------------
＞オプションボタンを作ってはどうですか？
Range("D1")に「吹替」、 Range("E1")に「吹替なし」
Range("D2:D34")及びRange("E2:E34")に
66個のオプションボタンを配置して
同じ行のE及ぶDでは、片方しか選択できない
（「吹替」又は「吹替なし」のどちらかしかマークを付けられない）
でどうかと考えたのですが ？
最終的には、一覧表として他の項目も印刷するのですが
Ｅ列は印刷しないでＤ列（吹替）のみ印刷する予定です。
（印刷前に別シートにＤ列で選択＝マークを付けた所は
「吹替」と書き込んでから印刷する。）
まず、66個のオプションボタンを配置する時点で挫折しています。
一つずつコピーして移動＞配置するのは大変です。
もっと簡単な方法はありませんか ？
(マクロで処理出来れば嬉しいです。）
＞同じ行のE及ぶDでは、片方しか選択できない
このコードはどうなりますか ？
（KonNo） 2021/09/29(水) 11:14
入力規則で、「吹替,吹替なし, 」と設定しておいて、下記でどうでしょう。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRNG As Range, bufRNG As Range
Set bufRNG = Intersect(Target, Range("D2:D34"))
If Not bufRNG Is Nothing Then
Application.EnableEvents = False
For Each MyRNG In bufRNG
If MyRNG.Value = "吹替なし" Then MyRNG.Value = " "
Next MyRNG
Application.EnableEvents = True
End If
End Sub
「吹替なし」を選択したときに全角空白に書き換えます。
ドロップダウンリストの最後に全角空白が来るのがちょっとですので、参考程度に。
（hatena） 2021/09/29(水) 11:47
■１
＞該当セルをクリックするとチェックボタンが右隣に画面表示されて ＞ チェックを入れると（ON）当該セルに「吹替」を書き込む ＞ チェックを消すと（OFF) 当該セルに「 」（全角スペース）を書き込む ＞のように変更したいとの希望でした。 ＞ （書き込みが終了するとチェックボタンが画面から消える） ＞昨日教えてもらったchangeイベントが利用できそうですが
changeイベントは利用できないとおもいます。
回答を鵜呑みにするのではなく、ちゃんとご自身でも調べれば理解できたかと思いますが、Changイベントは【セルの値が書き換えられた】ときに発生します。
(【セルをクリックしたとき】ではありません。)
そして、（私がしらないだけかもしれませんが）普通のクリックを発動条件にするイベントは無かったと思いますのでダブルクリックや右クリックのイベントを紹介した次第です。
なので↓のようなことであれば仰ってることは実現可能だとおもいます。
(0)ユーザーフォームで「チェックボタン」（チェックボックスを配置）を作っておく
(1)ダブルクリック（右クリック）されたら、ユーザーフォームを起動 (2)ユーザーフォーム起動時にアクティブセルの値に応じてチェックボックスの状態を切り替える (3)チェックボックスのクリックイベントで、アクティブセルに書き込みを実施 (3)気が済んだらチェックボタン（ユーザーフォーム）を閉じる
とすれば実現は可能だとおもいます。
ざっくりコードにするとこんな感じ
【シートモジュール】
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("D2:D34")) Is Nothing Then Exit Sub
Cancel = True
UserForm1.Show
End Sub
【ユーザーフォームモジュール】
Private Sub UserForm_Initialize()
Me.CheckBox1.Value = (ActiveCell.Value = "吹替")
End Sub
'----------------------------------------------------------------
Private Sub CheckBox1_Click()
ActiveCell = IIf(Me.CheckBox1.Value, "吹替", "")
End Sub
■２
ただ、実現するにはそれなりに手当をすることが増えるので、単に「 」が入力されているのか、そうでないのかわからないといったことが問題であれば、マクロなんぞ使わずに
・「吹替」あるいは「 」を入力してください。（入力規則から選択してもらってもokです） ・入力されたことをチェックするために入力したセルには条件付き書式で色が付くようになってます
ということを周知すればいいだけのような気がします。
（もこな２） 2021/09/29(水) 12:25
シート上にフォームコントロールのチェックボックスを配置します。
初めて配置すると「チェックボックス 1」と名前が付きます。
右クリック→マクロの登録で新規作成をクリック。
標準モジュールが開き雛形が表示されるので、それを下記のように修正します。
Sub チェック1_Click()
If ActiveCell.Value = "吹替" Then
ActiveCell.Value = " "
Else
ActiveCell.Value = "吹替"
End If
End Sub
シートのモジュールに下記のコードを記述します。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count = 1 And Not Intersect(Target, Range("D2:D34")) Is Nothing Then
With CheckBoxes("チェック 3")
.Top = ActiveCell.Top
.Left = ActiveCell.Left + ActiveCell.Width
.Visible = True
If Target.Value = "吹替" Then
.Value = xlOn
Else
.Value = xlOff
End If
End With
Else
CheckBoxes("チェック 3").Visible = False
End If
End Sub
これで、D2:D34の一つのセルを選択すると、その右にチェックボックスが表示されて、
チェックすると 吹替、チェックを外すと全角空白が入力されます。
（hatena） 2021/09/29(水) 12:29
上記の CheckBoxes("チェック 3") の部分の「チェック 3」は実際のチェックボックス名に修正しておいてください。
初めての挿入なら「チェックボックス 1」
（hatena） 2021/09/29(水) 12:36
入力規則で、「吹替,吹替なし, 」 ＋ Worksheet_Change のコード
試してみましたが、「吹替,吹替なし, 」の3種類どれを選択しても
「吹替」となって「吹替なし」を選択したときに全角空白に書き換えが確認できません。
私のアプローチでミスが有りそうですが良く分かりません。
「チェックボックスを使うサンプル」の件
実際試してみたいと思います。
少し、時間を下さい。
'---------------------------------------------------
もこな2さん、
普通のクリックを発動条件にするイベントは無かったと思いますので ダブルクリックや右クリックのイベントを紹介した次第です。
そもそも発想の時点で無理が有るのですね。
注文を挙げた当事者には、理由を伝えて希望のような提案の件は
難しいので諦めるように説得する事にします。
（理由があれば、こちらも説得できるかと。。。。）
ユーザーフォームで「チェックボタン」（チェックボックスを配置）を作っておく件は、
自分の知識向上のため試してみます。
（KonNo） 2021/09/29(水) 12:50
チェックボックスを使うサンプルも、動作すのを確認済みです。
実際に試してみると、
入力規則だと、セル選択→ドロップダウンボタンクリック→選択の3アクションですが、
チェックボックスだと、セル選択→チェックボックスクリックの2アクションですので、
後者の方がいいかなという思いました。
（hatena） 2021/09/29(水) 14:06
「チェックボックスを使うサンプルを作成してみました。」の件です。
D2:D34の「入力規制」をクリアー
アドバイスを受けて
１）シート上にフォームコントロールのチェックボックスを配置
（名前は、「チェックボックス 12」と表示されました。
昨日からテスト目的で何度かチェックボッイクスを作成していたので
12になっていると思われます。）
２）「チェックボックス 12」にコピペでマクロ登録（標準モジュールのModule3に記載）
３）シート(sheet1）にコピペでコードを記載
D2:D34内でセルをクリックすると
「チェックボックス12」が表示されて
記載がない無い場合チェックを入れると「吹替」と表示されますが
チェックを消しても「全角空白」にならない。
「吹替」と表示されているセルをクリックして
「チェック12」のチェックが有ると無し（無チェック）の2種類が有ります。
チェック無しをもう一度チェック有りに変えるとそれ以後はチェックが消える事はありません。
どうも思っていたように「吹替」と「全角空白」が切り替わらないようです。
（KonNo） 2021/09/29(水) 14:16
新規にシートを追加して、そこで一から2021/09/29(水) 12:29の回答通りに作成したらどうなりますか。
（hatena） 2021/09/29(水) 14:26
2021/09/29(水) 12:25 のユーザーフォームを利用する件は
上手く処理できました。
ユーザーフォームなので
好きにラベルが使えてコメントが付加できるので便利です。
理想を言えば、
ユーザーフォームが「吹替」を書き込むセルの近くに表示されと
視点が左右に移動しないので嬉しいです。
（KonNo） 2021/09/29(水) 14:32
ユーザーフォームが「吹替」を書き込むセルの近くに表示されと 視点が左右に移動しないので嬉しいです。
下記が参考になるかと。
http://www2.aqua-r.tepm.jp/~kmado/ke13u009.html
（hatena） 2021/09/29(水) 15:42
新規にシートを追加して、 そこで一から2021/09/29(水) 12:29の回答通りに作成したらどうなりますか。
新規作成では、上手く処理できています。
原因は、上手くいかないBOOKには
標準モジュールの他に同じシートにも他のマクロが登録されているので
それが干渉して上手く処理できていないと思われます。
私には、現用のBOOKではBUG取りは無理そうなので
せっかく教えてもらったhatenaさんのコードは今回は利用できそうもありません。
（教えてもらったコードは他で利用できるかもしれませんので
KEEPホルダーに説明書付きで保存しました。）
協力ありがとうございました。
（KonNo） 2021/09/29(水) 16:11
標準モジュールの他に同じシートにも他のマクロが登録されているので それが干渉して上手く処理できていないと思われます。
干渉するとなると、 Worksheet_Changeぐらいしかないと思いますが、そのブックにはWorksheet_Changeプロシージャはありますか。
（hatena） 2021/09/29(水) 16:25
１)新規にModule3を追加
Module3に記事の最初にある
「標準モジュール」と記載されたコードをコピペ
記事内の
Option Private Module も追加しています。
2)
フォームモジュールに
記事の「フォームモジュール」を追加
もなこ2さんの12：25の記事に同じ「UserForm_Initialize」があるので
入れ替えました。
同じく、もなこ2さんの下記コードも削除
Private Sub CheckBox1_Click()
ActiveCell = IIf(Me.CheckBox1.Value, "吹替", "")
End Sub
1),2)後にD2:D33内のセルをダブルクリックするも
以下のpoxでエラーが出ます。
コンパイルエラー ： 変数が定義されていません。
Private Sub UserForm_Initialize()
If kPosCell(Me, pox, poy) = -1 Then Exit Sub
上手く変数の受け渡しが出来ていないようです。
なぜでしょうか ？
（KonNo） 2021/09/29(水) 16:42
ちょっと気になったのは、下記の部分。
もなこ2さんの12：25の記事に同じ「UserForm_Initialize」があるので 入れ替えました。
入れ替えるのではなく、中身を追加してください。
下記のようになります。
Option Explicit
'kPosCell関数の利用例
Private Sub UserForm_Initialize()
Dim pox#, poy#
If kPosCell(Me, pox, poy) = -1 Then Exit Sub
StartUpPosition = 0
Left = pox
Top = poy
Me.CheckBox1.Value = (ActiveCell.Value = "吹替")
End Sub
（hatena） 2021/09/29(水) 23:26
＞干渉するとなると、 Worksheet_Changeぐらいしかないと思いますが、
＞そのブックにはWorksheet_Changeプロシージャはありますか。
Worksheet_Changeプロシージャはありません。
長くなりますが、以下に全文を記載します。
(以前不必要なので削除した Module1は、欠番です。）
'----------------------------- 以下 Sheet1（コード）
Private Sub CommandButton1_Click()
'クリアー
Range("A2:A40").UnMerge
Range("A1:A40").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("b2:e33").ClearFormats
Range("b2:e33") = ""
Range("A2:e33").Borders.LineStyle = True
End Sub
Private Sub CommandButton2_Click()
'行追加
'
Dim RowsNo As Long
Dim xCount As Integer
Dim ROOP As Integer
Dim xRange As Range
Dim xRow As Long
Dim Target As Long
KAISUU:
xCount = Application.InputBox("追加行数の数は ？", "追加行数 (1-5）", , , , , , 1)
'処理キャンセル
If xCount = 0 Then
Exit Sub
Else
'処理回数は1-5でそれ以外は、再入力
If xCount < 1 Or xCount > 5 Then
MsgBox "追加行数は１以上５以下です。指定回数を見直してください。", vbInformation, "追加行数のミス"
GoTo KAISUU
End If
End If
'行追加
For ROOP = 1 To xCount
RowsNo = ActiveCell.Row + 1
Rows(RowsNo).Select
Selection.Insert Shift:=xlDown
Cells(RowsNo, 1) = Cells(RowsNo - 1, 1).Value
'Cells(RowsNo, 2) = Cells(RowsNo - 1, 2).Value
Next ROOP
'同じ内容のセルを結合
Target = 1
Set xRange = Range("A2")
For xRow = 1 To Cells(Rows.Count, 1).End(xlUp).Row
With Cells(xRow, Target)
If .Value = .Offset(1, 0).Value Then
Set xRange = Union(xRange, .Offset(1, 0))
Else
Application.DisplayAlerts = False
xRange.Merge
Application.DisplayAlerts = True
Set xRange = .Offset(1, 0)
End If
End With
Next
End Sub
Private Sub CommandButton3_Click()
’結合解除
Range("A2:A40").UnMerge
Range("A1:A40").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Private Sub CommandButton4_Click()
'印刷
Call 印刷
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'by hatena 12:29
If Target.Cells.Count = 1 And Not Intersect(Target, Range("D2:D34")) Is Nothing Then
With CheckBoxes("チェック 12")
.Top = ActiveCell.Top
.Left = ActiveCell.Left + ActiveCell.Width
.Visible = True
If Target.Value = "吹替" Then
.Value = xlOn
Else
.Value = xlOff
End If
End With
Else
CheckBoxes("チェック 12").Visible = False
End If
End Sub
'--------------------------------- 以下 Module2
Sub 印刷()
Dim strCellArea As String
'印刷範囲
strCellArea = "A1:E40"
'選択したセル範囲で印刷プレビュー実施
With ActiveSheet
.PageSetup.PrintArea = strCellArea '印刷範囲を設定
.PrintPreview
'印刷範囲が設定後残ってしまうと
' 次の印刷時に影響が出るので、最後にクリア
.PageSetup.PrintArea = ""
End With
End Sub
'---------------------------以下 Module3
Option Explicit
’by hatena 12：29
Sub チェック12_Click()
If ActiveCell.Value = "吹替" Then
ActiveCell.Value = " "
Else
ActiveCell.Value = "吹替"
End If
End Sub
（KonNo） 2021/09/30(木) 05:32
入れ替えるのではなく、中身を追加してください。
アドバイスを受けて以下に修正しました。
（一部、不要なコメントが有りますが、以前のコード
又は参考に残しているコード又です。）
（以下以外は、05:32と同じコードが存在します。）
結果ですが
D2:D34中のセルをダブルクリックでユザーフォームは出ますが
チェックをクリックしても何もセルには変化がありません。
（吹替の表示、非表示が機能しない）
又、ユーザーフォームの表示位置もターゲットセルの横に移動せずに
元のまま離れた位置に表示されます。
'----------------- ユーザーフォームのコード
Option Explicit
Private Sub UserForm_Initialize()
Dim pox#, poy#
If kPosCell(Me, pox, poy) = -1 Then Exit Sub
StartUpPosition = 0
Left = pox
Top = poy
Me.CheckBox1.Value = (ActiveCell.Value = "吹替")
End Sub
'----------------------------------------------------------------
'Private Sub CheckBox1_Click()
' ActiveCell = IIf(Me.CheckBox1.Value, "吹替", "")
'End Sub
'オリジナル
'kPosCell関数の利用例
'Private Sub UserForm_Initialize()
'Dim pox#, poy# 'If kPosCell(Me, pox, poy) = -1 Then Exit Sub 'StartUpPosition = 0 'Left = pox 'Top = poy 'End Sub
’-----------------------以下 Module3 （05：32のコードと入れ替えています。）
Option Explicit
Option Private Module
'kPosCell関数
'セルのスクリーン座標を取得します ポイント単位
'引数 uf ユーザーフォーム
' psx,poy セル座標、pos セル位置(既定値はActiveCellの右下)
' kx,ky ポイント・ピクセル変換係数
'戻り値 0=成功 -1→未対応
Function kPosCell(uf As Object, ByRef pox#, ByRef poy#, Optional pos As Range, _
Optional ByRef kx#, Optional ByRef ky#) As Long If ActiveWindow.Panes.Count > 1 Then kPosCell = -1: Exit Function
Dim zx#, zy#, pxx&, pxy&, pxx1&, pxy1& Dim ww&, hh&, deskw&, deskh&, ia As IAccessible
Set ia = uf
ia.accParent.accLocation 0, 0, ww, hh
kx = uf.Width / ww: ky = uf.Height / hh
If pos Is Nothing Then Set pos = ActiveCell.Offset(1, 1) '右下
With ActiveWindow
pxy = pos.Height / kx
pxy1 = pxy * .Zoom / 100
zy = pxy1 / pxy
pxx = pos.Width / ky
pxx1 = pxx * .Zoom / 100
zx = pxx1 / pxx
pox = ky * .PointsToScreenPixelsX(0) + pos.Left * zx
poy = kx * .PointsToScreenPixelsY(0) + pos.Top * zy
End With
End Function
（KonNo） 2021/09/30(木) 05:54
まず、前者のチェックボックスの方のコードですが、コマンドボタンのコードは悪影響があるような記述はみられません。SelectionChangeとチェックボックスから呼び出される標準モジュールのコードも私のサンプルと差はないようです。
ちょっと、うまく動作しない原因は私には分かりません。
後者のユーザーフォーム使用のコードも私のサンプルと違いはないので、うまくいかない原因は思いつきません。
お役に立てなくて申し訳ない。他の方のアドバイスをお待ちください。
（hatena） 2021/09/30(木) 09:36
後上手く処理できない原因として考えられるのは
追加されたライブラリファイル と
「Classic Menue for Office」と言うアドインを導入している事だと思います。
hatenaさんでは上手く作動している事なので
他の方のアドバイスを待ちたいと思います。
お疲れさまでした。
（KonNo） 2021/09/30(木) 10:33
'Private Sub CheckBox1_Click()
' ActiveCell = IIf(Me.CheckBox1.Value, "吹替", "")
'End Sub
（もこな２） 2021/09/30(木) 10:49
頭を冷やして、
もう一度最初から試してみました。
（最初から使用していたEXCELのブックは、
試用の為 何度もコードやシート内を書き込み/消去/保存を繰り返して
おかしくなったように思えたので新ブックから作成して
そこにコードを新規にコピペしてお二人のコードを試してみました。）
以下の結果から見ると、
やはり最初から試用していたブックを操作中におかしな状態になっていたようです。
もこな2さんのコード(2021/09/29 09:27)は、
対象セルのみダブルクリックをするたびに「吹き替え」とブランクセルが切り替わりました。
hatenaさんのコード(2021/09/29 11:47)は、
「吹替なし」を選択したときに全角空白に変りました。
もこな2さんのコード(2021/09/29 12:25)は、
ユザーフォームからチェックボタンで「吹替」が切り替えできました。
hatenaさんのコード(2021/09/29 12：36)は、
右にチェックボックスが表示されて、チェックすると
吹替、チェックを外すと全角空白が入力されました。
hatenaさんの参考記事による
「ユーザーフォームが「吹替」を書き込むセルの近くに表示される」件
も「もこな2」さんが気が付いてダメだしされたコード削除を復活させて
セルの近くに表示されるようになりました。
hatenaさん、もこな2さん
最後までお付き合い願いありがとうございました。
（KonNo） 2021/10/01(金) 09:54
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.