[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『タッチパネルのエクセル表のセルの色を変える』（定年前おじいさん）
タッチパネルのエクセル表内の該当するセルにタッチして色を変えるマクロを考えています。
ネットで色々調べ集めて組みましたが、一長一短でうまくいきません。
ご教授をよろしくお願い致します。
内容は下記の通りです。
●シートに表は2か所あります。
対象表：
表(1)はC6:I13
表(2)はC17:O25
●表毎にタッチして表示する色を変えるパターンが違います。
表(1)：青⇒濃青⇒白（色無し？元に戻る？）
表(2)：青⇒濃青⇒薄青⇒白（色無し？元に戻る？）
●セル内のテキストは日々変わります。編集可が必要です。
そのセルにタッチして色を変えてチェックを入れていきます。
●翌朝（仕事終わり）にセルの色をクリアにして、セル内容を変更します。
＜ 使用 Excel：Excel2007、使用 OS：Windows8 ＞
>組みましたが、一長一短 どのようやったのか書いてください。その短所、長所も説明してください。 なぜ、自分でやったことを隠して、回答者から一方的に知識を収奪するようなことをするのですか？ （´・ω・`） 2020/10/03(土) 23:02
下記が組み合わせたマクロです。よろしくお願い致します。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then End
If Not (Target.Row >= 6 And Target.Row <= 25 And Target.Column >= 3 And Target.Column <= 15) Then End
If Target.Interior.ColorIndex = 2 Then
Target.Interior.ColorIndex = 33 ElseIf Target.Interior.ColorIndex = 33 Then Target.Interior.ColorIndex = 32 ElseIf Target.Interior.ColorIndex = 32 Then Target.Interior.ColorIndex = 34 Else Target.Interior.ColorIndex = 2 End If
Application.EnableEvents = False
Range("C1").Select
Application.EnableEvents = True
End Sub
Sub ボタン1_Click()
Range("C6", "O25").Interior.ColorIndex = 2
End Sub
短所：
●マクロを停止しないとセルの編集が出来ない。
●マクロの停止は起動時でないと出来ない。
●マクロの開始は起動時でないと出来ない。
そこで、編集用別シートをもうけたが、メインシートのフォントの色を変更できなかった。
●色変サイクルは２パターンあるが、兼用になっている。
長所：
ペンでタッチしたセルの色が変わって行く。
※編集用のPCと作業用のPCは別なので問題ないと考えましたが、変更が必要でした。
ご教授をよろしくお願い致します。
（定年前おじいさん） 2020/10/04(日) 21:06
悩みどころが分かりました。
(1) Worksheet_SelectionChange を使っているので、
連続してタッチしても色が変わらない
(2) (1)を回避するために、都度、自動でC1セルを選択させている
(3) (2)のために、表無いの選択セルを編集できない
SelectionChange を諦めて、BeforeDoubleClickイベントを使うのがいいのですが、 タッチからダブルタッチへの仕様変更は無理でしょうか。
>色変サイクルは２パターンあるが、兼用になっている。 これは、選択セルが、表内にあるかどうかの判定の仕方を変えれば解決します。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Exit Sub
If Not Intersect(Target, Me.Range("C6:I13")) Is Nothing Then
With Target.Interior
Select Case .ColorIndex
Case xlColorIndexNone
.ColorIndex = 33
Case 33
.ColorIndex = 32
Case Else
.ColorIndex = xlColorIndexNone
End Select
End With
Cancel = True ' 編集モードに入らない
End If
If Not Intersect(Target, Me.Range("C17:O25")) Is Nothing Then
With Target.Interior
Select Case .ColorIndex
Case xlColorIndexNone
.ColorIndex = 33
Case 33
.ColorIndex = 32
Case 32
.ColorIndex = 34
Case Else
.ColorIndex = xlColorIndexNone
End Select
End With
Cancel = True ' 編集モードに入らない
End If
End Sub
（´・ω・`） 2020/10/04(日) 21:58
途中参加ですが、チェンジイベントでも、例えばc1セルが1だったら、イベント後処理開始、 0だったら、イベント発生するけど処理せず抜けるコードにしてしまえばいかがですか？
あとは試してないけど、ユーザーフォームをmodelessで開いてフォーカス移しておいて、 再度同じところクリックしてみるとか、、、
（稲葉） 2020/10/05(月) 23:39
色々試したけど、どこにフォーカス移っても、Selectセルは変わらないから、イベント起きなかった
C1が1以外なら、処理しないので、文字の編集する場合は、C1セルを1以外にしておいてください。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim strRng(1) As String
strRng(0) = "C17:O25"
strRng(1) = "C6:I13"
If Target.CountLarge > 1 Then Exit Sub
If Range("C1").Value = 1 Then
If Intersect(Target, Range(Join(strRng, ","))) Is Nothing Then Exit Sub
With Target.Interior
Select Case .ColorIndex
Case xlColorIndexNone
.ColorIndex = 33
Case 33
.ColorIndex = 32
Case 32
If Intersect(Target, Range(strRng(0))) Is Nothing Then
.ColorIndex = xlColorIndexNone
Else
.ColorIndex = 34
End If
Case Else
.ColorIndex = xlColorIndexNone
End Select
End With
Application.EnableEvents = False
Range("C1").Activate
Application.EnableEvents = True
End If
End Sub
（稲葉） 2020/10/06(火) 11:16
質問者さんがその後こないので、アレなんですが、
Worksheet_BeforeRightClick をつかったら、タッチパネルだと長押しのハズなので、 そのほうが使い勝手がいいかなと思いました。 （´・ω・`） 2020/10/06(火) 11:30
＞Worksheet_BeforeRightClick をつかったら、タッチパネルだと長押しのハズなので、 そうなんですね 確かに長押しのほうがいいかも・・・ テストしてて思ったのが、UnDoが効かないので間違えた時の対策が今一つ・・・
（稲葉） 2020/10/06(火) 11:40
＞※編集用のPCと作業用のPCは別なので
セルの内容を編集するときは、
色は変えなくていいし、
選択毎に色を変えたいときは、
セルの内容を編集しなくていいということですか？
（まっつわん） 2020/10/06(火) 17:51
まっつわん 様
その通りです。
だから行けると思ったのですが、作業担当の方がマクロの有効無効で・・・。
抵抗無くストレートに作業が出来る様に。と。
大きな壁にぶつかり助けを求めました。
（定年前おじいさん） 2020/10/07(水) 22:30
>長所： ペンでタッチしたセルの色が変わって行く。 これは長所といえるのか。マウスでも出来るぞよ。 （VV） 2020/10/07(水) 23:03
あ、なんだこれ
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Exit Sub
2行目のExit Sub 消してください。
（´・ω・`） 2020/10/07(水) 23:06
NEC VALUESTAR VSS70/R を使用しています。 ディスプレイはタッチパネル仕様です。 初めてタッチパネルを使用しました。 稲葉さんのコードを試用させてもらいました。 ワンタッチで青⇒濃青⇒白の順に色が変わりました。 今後のために参考にさせていただきます。 （´・ω・`）さんのも試用させてもらいましたが ダブルタッチしても無反応でした。( Exit Sub 消去したうえで) 何かやり方間違っていますかね。 （KLY） 2020/10/08(木) 00:31
マウスのダブルクリックでも反応しないならマクロのせい マウスではできるけど、タッチパネルでできないなら、タッチパネル関係の設定のせい でしょうね （´・ω・`） 2020/10/08(木) 09:42
>タッチパネル関係の設定のせいでしょうね 設定といえばタップするスピードの調整だけです。 ファイルをダブルタップすると開きます。 タッチパネルは使用しないのでどうでもいいですけどね 。 （KLY） 2020/10/08(木) 15:05
KLVさん マウスでダブルクリックしたら動くんでしょうか？動かないんでしょうか？ （´・ω・`） 2020/10/08(木) 15:20
（´・ω・`） さんマウスは動作します。 （KLY） 2020/10/08(木) 16:09
KLYさん 情報ありがとうございます。 マウスとタッチパネルで、動作が異なるということですね。そうなると私にはわかりません。 先ほど名前間違えました。重ねてすみません。 （´・ω・`） 2020/10/08(木) 16:14
KLVさん > ダブルタッチしても無反応でした。( Exit Sub 消去したうえで) ´・ω・`さん >タッチパネルだと長押しのハズなので、
ダブルタッチではなく長押しで試したらどうだろうか？
（ねむねむ） 2020/10/08(木) 16:19
あ、KLYさん名前を間違えてしまってすまない。 （ねむねむ） 2020/10/08(木) 16:22
ねむねむさん 提示したコードはダブルクリック（ダブルタップ） 新しい提案が右クリック（長押しタップ） だと思います！
（稲葉） 2020/10/08(木) 16:45
稲葉さん >Worksheet_BeforeRightClick をつかったら、タッチパネルだと長押しのハズなので 確かにそうですね。 勘違いな発言をしてしまってすみません。 （ねむねむ） 2020/10/08(木) 16:47
私はタブレットPC持ってないので、是非BeforeRightClickに変更したコードでも試してもらいたいですね。 （稲葉） 2020/10/08(木) 16:50
>Worksheet_BeforeRightClick をつかったら、タッチパネルだと長押しのハズなので >是非BeforeRightClickに変更したコードでも試してもらいたいですね 変更したコードで長押ししても無反応でした。 マウス右クリックは動作します。
言い忘れましたけど Excel2013、Windows10 です。 （KLY） 2020/10/08(木) 20:40
（KLY） 2020/10/08(木) 21:35
KLYさん 情報ありがとうございます。
私も検索してみましたが、海外でもいくつか事例が見つかりました。 ただ、バージョンが明記されてなかったので、2013だけの問題かどうかわかりません。
Windows8のドライバのバグの可能性もありそうですが、 そのあたりを確定するには情報が少なすぎます。
稲葉さんの Worksheet_SelectionChange を フラグでコントロールするという 解決方法がよさそうですね。 （´・ω・`） 2020/10/09(金) 10:37
前回は >>ファイルをダブルタップすると開きます。 だったので編集作業ではどうか確認してみました。 ・セルからはみ出た文字は列の境目をダブルタップすると自動調整になりました。 ・図形四角形をダブルタップするとカーソルが挿入され文字入力状態になりました。 一例ですが追加させていただきます。
>>（´・ω・`）さんのも試用させてもらいましたが ご迷惑かけたことお詫びします。
私とバージョンが異なるので 質問者の返信でどうなるか待っていたいと思います （KLY） 2020/10/09(金) 14:18
（まっつわん） 2020/10/09(金) 14:29
遅くなりました。
特に稲葉様。
ありがとうございます。思い通りに色が変わり、編集が出来ました。
この方法でチェックを入れるのは、私の職場が最初になるので、大変誇らしく思います。
大変助かりました。
これからも定年まで、改善していきたいと思います。
（定年前おじいさん） 2020/10/09(金) 22:02
私のは（´・ω・`）さんのパクりですので、特にというのは無いです 勉強にもなりました。
まっつわんさん >SelectionChangeイベントでアクティブセルの上にactivexコントロールのコマンドボタンを移動配置 流れとしては、scイベントで、onactionを張り付けた図形を移動 移動と同時にonactionのタップ有効フラグを設定、ontimeで500msで図形が元の場所に戻るようにする 500ms以内にタップされれば、色変更実行
こんな感じで疑似ダブルタップですかね？ （稲葉） 2020/10/10(土) 05:24
クリックは1回でいいはずですよね？
Option Explicit
Dim mrngEventArea As Range
Private Sub CommandButton1_Click()
Dim c As Range
Dim n As Long
Set mrngEventArea = Me.Range("C6:I13,C17:O25")
With Me.CommandButton1
Set c = .TopLeftCell
n = 色変更(c)
.BackColor = n
End With
c.Interior.Color = n
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim clrNumber As Long
Set mrngEventArea = Me.Range("C6:I13,C17:O25")
Set Target = Intersect(mrngEventArea, Target(1))
If Target Is Nothing Then Exit Sub
clrNumber = 色変更(Target)
With Me.CommandButton1
.Top = Target.Top
.Left = Target.Left
.Height = Target.Height + 2
.Width = Target.Width + 1
.Caption = Target.Text
.BackColor = clrNumber
End With
Target.Interior.Color = clrNumber
End Sub
Function 色変更(ByRef c As Range) As Long
Dim clrNumber As Long
Dim ix As Long
Dim n As Long
n = c.Interior.Color
If Intersect(mrngEventArea.Areas(1), c) Is Nothing Then
ix = Application.Match(n, Array(vbWhite, vbBlue, rgbNavyBlue, rgbLightSkyBlue), 0)
ix = ix Mod 4
clrNumber = Choose(ix + 1, vbWhite, vbBlue, rgbNavyBlue, rgbLightSkyBlue)
Else
ix = Application.Match(n, Array(vbWhite, vbBlue, rgbNavyBlue), 0)
ix = ix Mod 3
clrNumber = Choose(ix + 1, vbWhite, vbBlue, rgbNavyBlue)
End If
色変更 = clrNumber
End Function
こんな感じでいいのでは？
画面のボタンは影を付けて強調してもいいかもしれませんね。
行き当たりばったりなうえに頭が働かないようで、汚いコードになってしまった＾＾；
案はすぐ思いついたけど、
意外と面倒だったのでコード化に3〜4時間かかった＾＾；
うううう。色の変更部分は、
クリックイベントにまとめられますねー。直したいけどギブアップ＞＜
＞私の職場が最初になるので、大変誇らしく思います。
誰かをおだてて作ってもらっただけですよね？
自分で作ったわけでもなければ、
自分でメンテナンスできるわけでもないでしょうから、
誇れるとしたら、
「マクロを作れる人に頼む」という思い付きだけですよね？
他人の時間を使ったということを忘れないでください。
お金払って業者に頼むようにした方がよいかと思います。
(相場を知らないけど、1行1000円なら5万くらい？）
（まっつわん） 2020/10/10(土) 18:46
KLYさんの、ダブルタップイベントが発生しないことに対するコメントでは無かったわけですね 勘違いしました （稲葉） 2020/10/10(土) 20:20
Option Explicit
Const mcTable1 As String = "C6:I13"
Const mcTable2 As String = "C17:O25"
Private Sub CommandButton1_Click()
Dim n() As Variant
Dim i As Long
Dim rngTarget As Range
n = Array(vbWhite, vbBlue, rgbNavyBlue, rgbLightSkyBlue)
Set rngTarget = Me.CommandButton1.TopLeftCell
If Intersect(Me.Range(mcTable2), rngTarget) Is Nothing Then
ReDim Preserve n(2)
End If
For i = LBound(n) To UBound(n)
If n(i) = rngTarget.Interior.Color Then Exit For
Next
i = i + 1
If i > UBound(n) Then i = 0
rngTarget.Interior.Color = n(i)
Me.CommandButton1.BackColor = n(i)
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngEventArea As Range
Dim clrNumber As Long
If Target.CountLarge > 1 Then Exit Sub
Set rngEventArea = Me.Range(Join(Array(mcTable1, mcTable2), ","))
Set Target = Intersect(rngEventArea, Target)
If Target Is Nothing Then Exit Sub
With Me.CommandButton1
.Top = Target.Top + 1
.Left = Target.Left + 1
.Height = Target.Height + 2
.Width = Target.Width + 1
.Caption = Target.Text
End With
CommandButton1_Click
End Sub
誰かの参考になれば。。。
（まっつわん） 2020/10/11(日) 18:01
（誰かの参考になれば） 2020/10/11(日) 20:29
>確認しているのだろうか。
こちらではそんなことにはなりませんでした。
（まっつわん） 2020/10/11(日) 20:45
こんばんわ
セルの色を白にしているので、枠線は消えて見えます 罫線を設定している場合は、罫線は見えます。
コマンドボタンのCaptionはコマンドボタンのサイズとフォントの設定次第で見えない場合があります。 セルの高さを十分大きくすればCaptionは見えます。 （´・ω・`） 2020/10/11(日) 21:09
試してみました！ なるほど、これならC1選択しなくていいですね。 あとコマンドボタンじゃなくて、Labelコントロールにしたら、いい感じに文字も表示されました。
（稲葉） 2020/10/12(月) 08:59
>Captionは表示されない。 >確認しているのだろうか。 新規シートにコピペした状態で実行されたのではないか。
（PP） 2020/10/12(月) 10:33
キャプションも自分好みでボタンを大きめにしたりして見やすくしてました＾＾；
ラベルの方がよりよいかもですね＾＾
テーマは、
「セルにクリックイベント的なものを追加したように見せる」だと思います。
その辺の見せ方は、この案を発展させて、
個人で工夫されるであろうと思ってましたので、
言及してませんでした。失礼しました。
（まっつわん） 2020/10/12(月) 14:59
んーまっつわんさんの方法で色々研究してみて、ラベルコントロールの背景なしでやってみました。 なぜかカーソルがラベルの上からどかないと、色が更新されない・・・ 色を変えた後、ラベルを移動させて戻しても変わらず。 スクリーンアップデート入れても変わらず。 マウスオーバーなんてイベントないし・・・ タップ操作だと、カーソルって表示されるのでしょうか？
Option Explicit
Const mcTable1 As String = "C6:I13"
Const mcTable2 As String = "C17:O25"
Dim dic As Object
Private Sub Label1_Click()
Dim n As Long
Dim rngTarget As Range
If dic Is Nothing Then
Set dic = CreateObject("Scripting.Dictionary")
dic(vbWhite) = 0
dic(vbBlue) = 1
dic(rgbNavyBlue) = 2
dic(rgbLightSkyBlue) = 3
End If
Set rngTarget = Me.Label1.TopLeftCell
n = 3
If Intersect(Me.Range(mcTable2), rngTarget) Is Nothing Then
n = 2
End If
rngTarget.Interior.Color = dic.keys()((dic(rngTarget.Interior.Color) + 1) Mod n) '←セルの色は変わるが、マウスがラベルの上に載っていると色が変わらない
End Sub
Private Sub Worksheet_SelectionChange(ByVal target As Range)
Dim rngEventArea As Range
Dim clrNumber As Long
If target.CountLarge > 1 Then Exit Sub
Set rngEventArea = Me.Range(Join(Array(mcTable1, mcTable2), ","))
Set target = Intersect(rngEventArea, target)
If target Is Nothing Then Exit Sub
With Me.Label1
.BackStyle = fmBackStyleTransparent '←背景なし
.Top = target.Top + 1
.Left = target.Left + 1
.Height = target.Height - 2
.Width = target.Width - 2
End With
Label1_Click
End Sub
（稲葉） 2020/10/12(月) 19:34
>タップ操作だと、カーソルって表示されるのでしょうか？ 今回の場合は選択したセル枠に左上、右下に○が表示されるので どちらかの〇をタップすることによりカーソルを表示できます。
C6 を選択します。色が付きます
選択した状態で Enter キーまたは Tab キーを押していくと
C7、D6 以降セル範囲までに色が付いていきます。
これって Excel2013 の不具合ですか。
（KLY） 2020/10/13(火) 16:58
＞タップ操作だと、カーソルって表示されるのでしょうか？
タッチパネル環境はないのでマウスでの再現ですが、
一旦、非表示にして再表示なら透明が維持出来るようです。
excel2016
一例）
Private r As Range, rr As Range
Private Sub Label1_Click()
Me.Label1.Visible = False
If r Is Nothing Then Exit Sub
Select Case r.Interior.ColorIndex
Case 5: r.Interior.ColorIndex = 11
Case 11
If Intersect(r, rr.Areas(2)) Is Nothing Then
r.Interior.ColorIndex = xlNone
Else
r.Interior.ColorIndex = 8
End If
Case 8: r.Interior.ColorIndex = xlNone
Case Else
r.Interior.ColorIndex = 5
End Select
Me.Label1.Visible = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal target As Range)
If target.CountLarge > 1 Then Exit Sub
Set rr = Range("C6:I13,C17:O25")
Set r = Intersect(rr, target)
If r Is Nothing Then Exit Sub
With Me.Label1
.Top = r.Top
.Left = r.Left
.Height = r.Height
.Width = r.Width
.BackStyle = fmBackStyleTransparent '作成時設定しておく
.Caption = "" '作成時設定しておく
.Visible = True
End With
' Label1_Click
End Sub
（tokumei） 2020/10/13(火) 17:39
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.