LibreOffice Calc でワンタッチで行チェックする方法

前提・実現したいこと

Excelでワンタッチで行チェックする方法
に投稿されたコードをLibreOffice Calcで使用したく修正を行っています。
シートイベント「選択を変更した時」に登録しているのですが
ワンクリック毎に複数回実行されてしまうようで動作が不安定です。
ワンクリック毎に1回だけ実行されるようにするにはどのような方法がありますか？

発生している問題・エラーメッセージ

ワンクリック毎に3、4回実行されてしまうようです。
チカチカっとなって元に戻る症状は頻発、文字と色が一致しないこともあります。

該当のソースコード

vba
1REM  *****  BASIC  *****
2Option VBASupport 1
3Option Explicit
4
5Dim G_exec As Integer
6
7Sub Worksheet_SelectionChange(ByVal Target As Range)
8
9 	'dbg
10 	G_exec = G_exec + 1
11 	ThisWorkbook.WorkSheets(1).Cells(1,1) = G_exec
12 	ThisWorkbook.WorkSheets(1).Cells(1,3) = ""
13	
14  On Error Goto Er
15	
16  Const strRow = 2
17  Const endRow = 30
18  
19  Dim ChckOn As String
20  Dim ChckOff As String
21  
22  ChckOn = ChrW(9745) '選択状態の文字
23  ChckOff = ChrW(9744)  '非選択状態の文字
24
25  '次のxx行は連続しない複数セルの選択時エラーとなる。
26	'dbg
27	ThisWorkbook.WorkSheets(1).Cells(1,4) = Target.CellAddress.Row
28	ThisWorkbook.WorkSheets(1).Cells(1,5) = Target.CellAddress.Column
29	'dbgここまで
30  '対象がA列の指定範囲の1セルだけのとき
31  If Target.CellAddress.Column+1 <> 1 Then Exit Sub
32  If Target.CellAddress.Row+1 > endRow Then Exit Sub
33  If Target.CellAddress.Row+1 < strRow Then Exit Sub
34  If Target.Rows.Count > 1 Then Exit Sub
35  If Target.Columns.Count > 1 Then Exit Sub
36  
37 'Application.EnableEvents = False
38 ThisComponent.LockControllers
39  If Target.CellAddress.Column+1 = 1 Then
40    'チェックあり／チェックなしトグル動作。
41    'チェックありのときは背景は色付き
42    If Target.String = ChckOff Then
43      Target.String = ChckOn
44      With Rows(Target.CellAddress.Row+1).Interior
45        .Color = rgb(255,99,71)
46      End With
47    Else
48      Target.String = ChckOff
49      With Rows(Target.CellAddress.Row+1).Interior
50        .ColorIndex = xlNone
51      End With
52    End If
53  End If
54 
55	'Application.EnableEvents = True/False(VBA)に相当する記述が分からない ＆
56	'Target.Offset(0, 1).Select に相当する次の記述は
57      'ThisComponent.CurrentController.select (ThisComponent.CurrentController.ActiveSheet.getCellByPosition(2,Target.CellAddress.Row))
58      'カーソルが動く前にイベントが発生してしまう
59      'Wait 100 'millisec 効果なし
60      'Sleep 100
61      'DoEvents: DoEvents: DoEvents
62
63    ThisComponent.UnlockControllers
64    Exit Sub  '終了
65
66    Er:
67    'エラー発生時の処理を記述
68    'msgbox Error ,,"エラー"
69 	'dbg
70 	ThisWorkbook.WorkSheets(1).Cells(1,3) = "err"
71 	ThisWorkbook.WorkSheets(1).Cells(1,2) = ThisWorkbook.WorkSheets(1).Cells(1,2) + 1
72End Sub
73  'http://calibreblo.blogspot.com/2011/04/blog-post_1621.html
74  'LibreOffice Calc Basic fun!!!: セルの位置を取得
75  '.CellAddress.Column
76  '.CellAddress.Row
77  
78  'http://calibreblo.blogspot.com/2011/04/blog-post_26.html
79  'LibreOffice Calc Basic fun!!!: データが入力されている最終行・最終列を求める
80  '.Rows.Count
81  
82  'https://forum.openoffice.org/ja/forum/viewtopic.php?f=19&t=187
83  'Calcシート内の値があるすべてのセルを範囲とするプロパティ (トピック) • OpenOffice.org コミュニティーフォーラム
84  '.getRows.Count
85  '.getColumns.Count
86  
87  'https://ask.libreoffice.org/en/question/139060/how-to-retrieve-a-cell-value-using-libreoffice-basic/
88  '.Columns.getCount()
89  
90  'https://j11.blog.so-net.ne.jp/2013-10-18
91  '選択範囲の行、列の個数を調べる　Libreoffice Calc Basic：ubuntu & LibreOffice：So-netブログ
92 
93 'http://calibreblo.blogspot.com/2011/05/blog-post_12.html
94 'LibreOffice Calc Basic fun!!!: セルの背景色とフォントの色を設定する
95
96'https://forum.openoffice.org/en/forum/viewtopic.php?f=9&t=36641
97'Custom Cell Background (View topic) • Apache OpenOffice Community Forum
98'Fill_Cell_Backgrounds.ods by Charlie Young
99
100'https://stackoverflow.com/questions/32556294/how-to-change-the-background-color-of-a-cell-on-mouse-click-in-libre-office-calc
101'myCell = ThisComponent.CurrentController.Selection
102'myCell.CellBackColor = -1
103
104'https://improve-future.com/libreoffice-calc-basic-handle-cell-range.html
105'LibreOffice Calc: Basic でセルをまとめて扱う
106
107'http://itukamuikananoka.blog.fc2.com/blog-category-6.html
108'LibreOffice - いつか。むいか。なのか。
109'clearContents で書式のみ消す方法
110
111'http://www.vbaexpress.com/forum/showthread.php?11740-Solved-colorindex-xlnone
112'Solved: colorindex = xlnone ?
113
114'https://forum.openoffice.org/en/forum/viewtopic.php?f=9&t=39266
115'ActiveCell.Offset (View topic) • Apache OpenOffice Community Forum

試したこと

Now() で取得した時刻をグローバル変数で保持しておき、前回の実行時刻と今回の実行時刻が一定以下では即終了するようにしてもみましたが、改善はするもののしばしば誤動作しました。
（分解能が1秒程度のようで1000ms差になることがある。まれに「今回の実行時刻は前回の-1000ms後」という値も出る

補足情報（FW/ツールのバージョンなど）

LibreOffice 3.4.6, LibreOffice Portable 4.3.5.2
Windows Vista (SPはインストールが成功しない)

行動規範の内容に同意します

回答1件

自己解決

新たな参考資料(コード末尾に追記)からGetSystemTicks()でより高精度に時刻を取得できることが分かり、完全ではないものの症状が改善されました。

vba
1REM  *****  BASIC  *****
2Option VBASupport 1
3Option Explicit
4
5Dim G_exec, S As Integer
6Dim G_oldticks, G_oldrow, G_oldcol As Long
7
8Sub Worksheet_SelectionChanged(ByVal Target As Range)
9	'セルの内容を ChckOn / ChckOff  に設定した文字に交互に書き換えます
10
11	'仕様
12	'動作するのは対象セルが以下の条件を満たすとき
13	'1セル
14	'A列
15	'strRow行からendRow行まで
16	'既に ChckOn / ChckOff が入力されている
17
18	'制限事項
19	'このプログラムはシートイベントの
20	'SelectionChangedで駆動することを念頭に作成しましたが、
21	'SelectionChangedイベントはマウスクリック時３～４回発火するようです。
22	'例：ボタン押下時１回、離した時３回
23	'短時間の複数回実行は無視するようになっていますが
24	'ボタン押下～離すまで時間が空いたり
25	'時刻をうまく取得できなかったときなど
26	'不安定な挙動をすることがあります。
27
28	'dbg
29	G_exec = G_exec + 1
30	ThisWorkbook.WorkSheets(1).Cells(1,1) = G_exec
31	ThisWorkbook.WorkSheets(1).Cells(1,3) = ""
32
33	On Error Goto Er
34
35	Const strRow = 2
36	Const endRow = 30
37
38	Dim ChckOn As String
39	Dim ChckOff As String
40
41	ChckOn = ChrW(9745) '選択状態の文字☑
42	ChckOff = ChrW(9744)  '非選択状態の文字☐
43
44
45	'Main
46	Dim dticks, newticks As Long
47	Dim newrow, newcol
48	Dim oldrow, oldcol
49	newticks = getsystemticks()
50	dticks = newticks -  G_oldticks
51	G_oldticks = newticks
52
53	'If Target.Cells.Count > 1 Then Exit Sub 'Calcではエラー
54	If Target.Rows.Count > 1 Then Exit Sub
55	If Target.Columns.Count > 1 Then Exit Sub
56	If Target.CellAddress.Row+1 > endRow Then Exit Sub
57	If Target.CellAddress.Row+1 < strRow Then Exit Sub
58
59	'dbg
60	ThisWorkbook.WorkSheets(1).Cells(1,4) = Target.CellAddress.Row
61	ThisWorkbook.WorkSheets(1).Cells(1,5) = Target.CellAddress.Column
62	
63	newrow = Target.CellAddress.Row
64	newcol = Target.CellAddress.Column
65	oldrow = G_oldrow
66	oldcol = G_oldcol
67	G_oldrow = newrow
68	G_oldcol = newcol
69	If Target.CellAddress.Column+1 <> 1 Then Exit Sub
70	If dticks<500 then
71		If (newrow = oldrow) And (newcol = oldcol) Then exit sub
72	End If
73
74	If Target.String = ChckOff Then
75		Target.String = ChckOn
76		With Rows(Target.CellAddress.Row+1).Interior
77			.Color = rgb(255,99,71)
78		End With
79	ElseIf Target.String = ChckOn Then
80		Target.String = ChckOff
81		With Rows(Target.CellAddress.Row+1).Interior
82			.ColorIndex = xlNone
83		End With
84	Else
85		'
86	End If
87
88	Exit Sub  '終了
89
90 	Er:
91 	'エラー発生時の処理を記述
92 	'msgbox Error ,,"エラー"
93 	'dbg
94 	ThisWorkbook.WorkSheets(1).Cells(1,3) = "err"
95 	ThisWorkbook.WorkSheets(1).Cells(1,2) = ThisWorkbook.WorkSheets(1).Cells(1,2) + 1
96End Sub
97
98'http://calibreblo.blogspot.com/2011/04/blog-post_1621.html
99'LibreOffice Calc Basic fun!!!: セルの位置を取得
100'.CellAddress.Column
101'.CellAddress.Row
102
103'http://calibreblo.blogspot.com/2011/04/blog-post_26.html
104'LibreOffice Calc Basic fun!!!: データが入力されている最終行・最終列を求める
105'.Rows.Count
106
107'https://forum.openoffice.org/ja/forum/viewtopic.php?f=19&t=187
108'Calcシート内の値があるすべてのセルを範囲とするプロパティ (トピック) • OpenOffice.org コミュニティーフォーラム
109'.getRows.Count
110'.getColumns.Count
111
112'https://ask.libreoffice.org/en/question/139060/how-to-retrieve-a-cell-value-using-libreoffice-basic/
113'.Columns.getCount()
114
115'https://j11.blog.so-net.ne.jp/2013-10-18
116'選択範囲の行、列の個数を調べる　Libreoffice Calc Basic：ubuntu & LibreOffice：So-netブログ
117
118'http://calibreblo.blogspot.com/2011/05/blog-post_12.html
119'LibreOffice Calc Basic fun!!!: セルの背景色とフォントの色を設定する
120
121'https://forum.openoffice.org/en/forum/viewtopic.php?f=9&t=36641
122'Custom Cell Background (View topic) • Apache OpenOffice Community Forum
123'Fill_Cell_Backgrounds.ods by Charlie Young
124
125'https://stackoverflow.com/questions/32556294/how-to-change-the-background-color-of-a-cell-on-mouse-click-in-libre-office-calc
126'myCell = ThisComponent.CurrentController.Selection
127'myCell.CellBackColor = -1
128
129'https://improve-future.com/libreoffice-calc-basic-handle-cell-range.html
130'LibreOffice Calc: Basic でセルをまとめて扱う
131
132'http://itukamuikananoka.blog.fc2.com/blog-category-6.html
133'LibreOffice - いつか。むいか。なのか。
134'clearContents で書式のみ消す方法
135
136'http://www.vbaexpress.com/forum/showthread.php?11740-Solved-colorindex-xlnone
137'Solved: colorindex = xlnone ?
138
139'https://forum.openoffice.org/en/forum/viewtopic.php?f=9&t=39266
140'ActiveCell.Offset (View topic) • Apache OpenOffice Community Forum
141
142'https://vbabeginner.net/get-current-datetime-milliseconds/
143'VBAで現在日時をミリ秒単位で取得する ｜ Excel作業をVBAで効率化
144'kernel32 の GetLocalTime や GetSystemTime を使い1秒以下の精度で時刻を取得することもできた
145'本コードでは未使用
146    
147'https://forum.openoffice.org/en/forum/viewtopic.php?t=103709
148'Apache OpenOffice Community Forum - Selection Change Sheet Event executes 4 times - (View topic)
149'GetSystemTicks()