こんにちは。
VBAを使うことが、頻繁ではないですが、ちょくちょくあり、
その都度「コードってこれで良かったっけ？」「どう書くんだっけ？」
となることが、しばしば、、、あります。
その時その時で調べて、確認して、コードを書いてとしていたので、
自分が使いやすいように、コードをまとめます。
内容
エクセルシート上でマウスをダブルクリックした際の処理コードをまとめておきます。
シート「Shee1」でダブルクリックした際に、所定のセルに
・ダブルクリック時の日付と時間
・黄色塗りつぶしと「OK」
を入力するようにしました。
Cの10にマウスのポンタを持っていきます。
ここでダブルクリックをすると、
日付と時刻が入力されます。
次に、Fの10にマウスを持っていき、ダブルクリックすると、
黄色で塗りつぶし、「OK」と入力します。
ここで、再度Fの10の上にマウスを持ってきて、ダブルクリックをすると、
黄色塗りつぶしの「OK」が消えます。
なお、シート「Sheet1」のみに有効となるように設定しました。
コード
内容で記載した設定とコードを記載していきます。
まずは、シート「Shee1」でダブルクリックする際の設定です。
下図の赤枠で囲った部分を選択すると、図に表示されているコードが出てきます。
ダブルクリックをする前の処理になります。
ここにコードを書いていきます。
黄色塗りつぶしと「OK」の入力、再度ダブルクリックでの取り消しは、
関数にして書いております。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 |
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim strSelCell As String strSelCell = ActiveCell.Address() 'アクティブなセルの位置を取得 'MsgBox strSelCell Dim lonCellColor As Long lonCellColor = ActiveCell.Interior.Color 'セルの背景色を取得する。 'MsgBox lonCellColor 'MsgBox ActiveCell.Column 'MsgBox ActiveCell.Row '----------'ダブルクリック時に「時間」を入力する-------------- If ActiveCell.Column = 3 Then If ActiveCell.Row >= 10 Then If lonCellColor = 16777215 Then 'セル背景が白なら完了マークを付ける If ActiveCell.Value = "" Then 'セルに何も入力されていなければ Cells(ActiveCell.Row, ActiveCell.Column) = Now End If End If End If End If '----------'ダブルクリック時に「OK」を入力する-------------- '実行エリアの限定 If ActiveCell.Column <= 5 Then 'MsgBox 7 Exit Sub End If If ActiveCell.Row < 10 Then 'MsgBox 12 Exit Sub End If '完了マーク付けと付けたマークの取り消し If lonCellColor = 16777215 Then 'セル背景が白なら完了マークを付ける If ActiveCell.Value = "" Then Call setCompletionMark(strSelCell) End If ElseIf lonCellColor = 65535 Then '既に完了マークがついている場合、消す Call setMarkCansel(strSelCell) End If End Sub Sub setCompletionMark(pSelCell As String) Range(pSelCell).Select ActiveCell.FormulaR1C1 = "OK" Range(pSelCell).Select With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With End Sub Sub setMarkCansel(pSelCell As String) Range(pSelCell).Select ActiveCell.FormulaR1C1 = "" Range(pSelCell).Select With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 16777215 .TintAndShade = 0 .PatternTintAndShade = 0 End With End Sub |
なぜか、コードの色がおかしい、、、
セルをダブルクリックしてカウントアップするのにも使えそうです。
気が向いたら、まとめようと思います。
