質問編集履歴
2
誤記訂正
test
CHANGED
|
File without changes
|
test
CHANGED
|
@@ -132,167 +132,12 @@
|
|
|
132
132
|
'https://forum.openoffice.org/en/forum/viewtopic.php?f=9&t=39266
|
|
133
133
|
'ActiveCell.Offset (View topic) • Apache OpenOffice Community Forum
|
|
134
134
|
```
|
|
135
|
-
9/23追記 改良版
|
|
136
|
-
```vba
|
|
137
|
-
REM ***** BASIC *****
|
|
138
|
-
Option VBASupport 1
|
|
139
|
-
Option Explicit
|
|
140
|
-
|
|
141
|
-
Dim G_exec, S As Integer
|
|
142
|
-
Dim G_oldticks, G_oldrow, G_oldcol As Long
|
|
143
|
-
|
|
144
|
-
Sub Worksheet_SelectionChanged(ByVal Target As Range)
|
|
145
|
-
'セルの内容を ChckOn / ChckOff に設定した文字に交互に書き換えます
|
|
146
|
-
|
|
147
|
-
'仕様
|
|
148
|
-
'動作するのは対象セルが以下の条件を満たすとき
|
|
149
|
-
'1セル
|
|
150
|
-
'A列
|
|
151
|
-
'strRow行からendRow行まで
|
|
152
|
-
'既に ChckOn / ChckOff が入力されている
|
|
153
|
-
|
|
154
|
-
'制限事項
|
|
155
|
-
'このプログラムはシートイベントの
|
|
156
|
-
'SelectionChangedで駆動することを念頭に作成しましたが、
|
|
157
|
-
'SelectionChangedイベントはマウスクリック時３～４回発火するようです。
|
|
158
|
-
'例：ボタン押下時１回、離した時３回
|
|
159
|
-
'短時間の複数回実行は無視するようになっていますが
|
|
160
|
-
'ボタン押下～離すまで時間が空いたり
|
|
161
|
-
'時刻をうまく取得できなかったときなど
|
|
162
|
-
'不安定な挙動をすることがあります。
|
|
163
|
-
|
|
164
|
-
'dbg
|
|
165
|
-
G_exec = G_exec + 1
|
|
166
|
-
ThisWorkbook.WorkSheets(1).Cells(1,1) = G_exec
|
|
167
|
-
ThisWorkbook.WorkSheets(1).Cells(1,3) = ""
|
|
168
|
-
|
|
169
|
-
On Error Goto Er
|
|
170
|
-
|
|
171
|
-
Const strRow = 2
|
|
172
|
-
Const endRow = 30
|
|
173
|
-
|
|
174
|
-
Dim ChckOn As String
|
|
175
|
-
Dim ChckOff As String
|
|
176
|
-
|
|
177
|
-
ChckOn = ChrW(9745) '選択状態の文字☑
|
|
178
|
-
ChckOff = ChrW(9744) '非選択状態の文字☐
|
|
179
|
-
|
|
180
|
-
|
|
181
|
-
'Main
|
|
182
|
-
Dim dticks, newticks As Long
|
|
183
|
-
Dim newrow, newcol
|
|
184
|
-
Dim oldrow, oldcol
|
|
185
|
-
newticks = getsystemticks()
|
|
186
|
-
dticks = newticks - G_oldticks
|
|
187
|
-
G_oldticks = newticks
|
|
188
|
-
|
|
189
|
-
'If Target.Cells.Count > 1 Then Exit Sub 'Calcではエラー
|
|
190
|
-
If Target.Rows.Count > 1 Then Exit Sub
|
|
191
|
-
If Target.Columns.Count > 1 Then Exit Sub
|
|
192
|
-
If Target.CellAddress.Row+1 > endRow Then Exit Sub
|
|
193
|
-
If Target.CellAddress.Row+1 < strRow Then Exit Sub
|
|
194
|
-
|
|
195
|
-
'dbg
|
|
196
|
-
ThisWorkbook.WorkSheets(1).Cells(1,4) = Target.CellAddress.Row
|
|
197
|
-
ThisWorkbook.WorkSheets(1).Cells(1,5) = Target.CellAddress.Column
|
|
198
|
-
|
|
199
|
-
newrow = Target.CellAddress.Row
|
|
200
|
-
newcol = Target.CellAddress.Column
|
|
201
|
-
oldrow = G_oldrow
|
|
202
|
-
oldcol = G_oldcol
|
|
203
|
-
G_oldrow = newrow
|
|
204
|
-
G_oldcol = newcol
|
|
205
|
-
If Target.CellAddress.Column+1 <> 1 Then Exit Sub
|
|
206
|
-
If dticks<500 then
|
|
207
|
-
If (newrow = oldrow) And (newcol = oldcol) Then exit sub
|
|
208
|
-
End If
|
|
209
|
-
|
|
210
|
-
If Target.String = ChckOff Then
|
|
211
|
-
Target.String = ChckOn
|
|
212
|
-
With Rows(Target.CellAddress.Row+1).Interior
|
|
213
|
-
.Color = rgb(255,99,71)
|
|
214
|
-
End With
|
|
215
|
-
ElseIf Target.String = ChckOn Then
|
|
216
|
-
Target.String = ChckOff
|
|
217
|
-
With Rows(Target.CellAddress.Row+1).Interior
|
|
218
|
-
.ColorIndex = xlNone
|
|
219
|
-
End With
|
|
220
|
-
Else
|
|
221
|
-
'
|
|
222
|
-
End If
|
|
223
|
-
|
|
224
|
-
Exit Sub '終了
|
|
225
|
-
|
|
226
|
-
Er:
|
|
227
|
-
'エラー発生時の処理を記述
|
|
228
|
-
'msgbox Error ,,"エラー"
|
|
229
|
-
'dbg
|
|
230
|
-
ThisWorkbook.WorkSheets(1).Cells(1,3) = "err"
|
|
231
|
-
ThisWorkbook.WorkSheets(1).Cells(1,2) = ThisWorkbook.WorkSheets(1).Cells(1,2) + 1
|
|
232
|
-
End Sub
|
|
233
|
-
|
|
234
|
-
'http://calibreblo.blogspot.com/2011/04/blog-post_1621.html
|
|
235
|
-
'LibreOffice Calc Basic fun!!!: セルの位置を取得
|
|
236
|
-
'.CellAddress.Column
|
|
237
|
-
'.CellAddress.Row
|
|
238
|
-
|
|
239
|
-
'http://calibreblo.blogspot.com/2011/04/blog-post_26.html
|
|
240
|
-
'LibreOffice Calc Basic fun!!!: データが入力されている最終行・最終列を求める
|
|
241
|
-
'.Rows.Count
|
|
242
|
-
|
|
243
|
-
'https://forum.openoffice.org/ja/forum/viewtopic.php?f=19&t=187
|
|
244
|
-
'Calcシート内の値があるすべてのセルを範囲とするプロパティ (トピック) • OpenOffice.org コミュニティーフォーラム
|
|
245
|
-
'.getRows.Count
|
|
246
|
-
'.getColumns.Count
|
|
247
|
-
|
|
248
|
-
'https://ask.libreoffice.org/en/question/139060/how-to-retrieve-a-cell-value-using-libreoffice-basic/
|
|
249
|
-
'.Columns.getCount()
|
|
250
|
-
|
|
251
|
-
'https://j11.blog.so-net.ne.jp/2013-10-18
|
|
252
|
-
'選択範囲の行、列の個数を調べる Libreoffice Calc Basic：ubuntu & LibreOffice：So-netブログ
|
|
253
|
-
|
|
254
|
-
'http://calibreblo.blogspot.com/2011/05/blog-post_12.html
|
|
255
|
-
'LibreOffice Calc Basic fun!!!: セルの背景色とフォントの色を設定する
|
|
256
|
-
|
|
257
|
-
'https://forum.openoffice.org/en/forum/viewtopic.php?f=9&t=36641
|
|
258
|
-
'Custom Cell Background (View topic) • Apache OpenOffice Community Forum
|
|
259
|
-
'Fill_Cell_Backgrounds.ods by Charlie Young
|
|
260
|
-
|
|
261
|
-
'https://stackoverflow.com/questions/32556294/how-to-change-the-background-color-of-a-cell-on-mouse-click-in-libre-office-calc
|
|
262
|
-
'myCell = ThisComponent.CurrentController.Selection
|
|
263
|
-
'myCell.CellBackColor = -1
|
|
264
|
-
|
|
265
|
-
'https://improve-future.com/libreoffice-calc-basic-handle-cell-range.html
|
|
266
|
-
'LibreOffice Calc: Basic でセルをまとめて扱う
|
|
267
|
-
|
|
268
|
-
'http://itukamuikananoka.blog.fc2.com/blog-category-6.html
|
|
269
|
-
'LibreOffice - いつか。むいか。なのか。
|
|
270
|
-
'clearContents で書式のみ消す方法
|
|
271
|
-
|
|
272
|
-
'http://www.vbaexpress.com/forum/showthread.php?11740-Solved-colorindex-xlnone
|
|
273
|
-
'Solved: colorindex = xlnone ?
|
|
274
|
-
|
|
275
|
-
'https://forum.openoffice.org/en/forum/viewtopic.php?f=9&t=39266
|
|
276
|
-
'ActiveCell.Offset (View topic) • Apache OpenOffice Community Forum
|
|
277
|
-
|
|
278
|
-
'https://vbabeginner.net/get-current-datetime-milliseconds/
|
|
279
|
-
'VBAで現在日時をミリ秒単位で取得する ｜ Excel作業をVBAで効率化
|
|
280
|
-
'kernel32 の GetLocalTime や GetSystemTime を使い1秒以下の精度で時刻を取得することもできた
|
|
281
|
-
'本コードでは未使用
|
|
282
|
-
|
|
283
|
-
'https://forum.openoffice.org/en/forum/viewtopic.php?t=103709
|
|
284
|
-
'Apache OpenOffice Community Forum - Selection Change Sheet Event executes 4 times - (View topic)
|
|
285
|
-
'GetSystemTicks()
|
|
286
|
-
```
|
|
287
135
|
|
|
288
136
|
### 試したこと
|
|
289
137
|
|
|
290
138
|
Now() で取得した時刻をグローバル変数で保持しておき、前回の実行時刻と今回の実行時刻が一定以下では即終了するようにしてもみましたが、改善はするもののしばしば誤動作しました。
|
|
291
139
|
（分解能が1秒程度のようで1000ms差になることがある。まれに「今回の実行時刻は前回の-1000ms後」という値も出る
|
|
292
140
|
|
|
293
|
-
9/23追記
|
|
294
|
-
新たな参考資料(コード末尾に追記)からGetSystemTicks()でより高精度に時刻を取得できることが分かり、完全ではないものの症状が改善された。
|
|
295
|
-
|
|
296
141
|
### 補足情報（FW/ツールのバージョンなど）
|
|
297
142
|
|
|
298
143
|
LibreOffice 3.4.6, LibreOffice Portable 4.3.5.2
|
1
自決
test
CHANGED
|
File without changes
|
test
CHANGED
|
@@ -1,287 +1,299 @@
|
|
|
1
1
|
### 前提・実現したいこと
|
|
2
2
|
|
|
3
|
-
|
|
4
|
-
|
|
5
3
|
[Excelでワンタッチで行チェックする方法](https://okwave.jp/qa/q9518418.html)
|
|
6
|
-
|
|
7
4
|
に投稿されたコードをLibreOffice Calcで使用したく修正を行っています。
|
|
8
|
-
|
|
9
5
|
シートイベント「選択を変更した時」に登録しているのですが
|
|
10
|
-
|
|
11
6
|
ワンクリック毎に複数回実行されてしまうようで動作が不安定です。
|
|
12
|
-
|
|
13
7
|
ワンクリック毎に1回だけ実行されるようにするにはどのような方法がありますか？
|
|
14
8
|
|
|
15
|
-
|
|
16
|
-
|
|
17
9
|
### 発生している問題・エラーメッセージ
|
|
18
10
|
|
|
19
|
-
|
|
20
|
-
|
|
21
|
-
```
|
|
11
|
+
```
|
|
22
|
-
|
|
23
12
|
ワンクリック毎に3、4回実行されてしまうようです。
|
|
24
|
-
|
|
25
13
|
チカチカっとなって元に戻る症状は頻発、文字と色が一致しないこともあります。
|
|
26
|
-
|
|
27
|
-
```
|
|
14
|
+
```
|
|
28
|
-
|
|
29
|
-
|
|
30
15
|
|
|
31
16
|
### 該当のソースコード
|
|
32
17
|
|
|
33
|
-
|
|
34
|
-
|
|
35
18
|
```vba
|
|
36
|
-
|
|
37
19
|
REM ***** BASIC *****
|
|
38
|
-
|
|
39
20
|
Option VBASupport 1
|
|
40
|
-
|
|
41
21
|
Option Explicit
|
|
42
22
|
|
|
43
|
-
|
|
44
|
-
|
|
45
23
|
Dim G_exec As Integer
|
|
46
24
|
|
|
47
|
-
|
|
48
|
-
|
|
49
25
|
Sub Worksheet_SelectionChange(ByVal Target As Range)
|
|
50
26
|
|
|
51
|
-
|
|
52
|
-
|
|
53
27
|
'dbg
|
|
54
|
-
|
|
55
28
|
G_exec = G_exec + 1
|
|
56
|
-
|
|
57
29
|
ThisWorkbook.WorkSheets(1).Cells(1,1) = G_exec
|
|
58
|
-
|
|
59
30
|
ThisWorkbook.WorkSheets(1).Cells(1,3) = ""
|
|
60
|
-
|
|
61
31
|
|
|
62
|
-
|
|
63
32
|
On Error Goto Er
|
|
64
|
-
|
|
65
33
|
|
|
66
|
-
|
|
67
34
|
Const strRow = 2
|
|
68
|
-
|
|
69
35
|
Const endRow = 30
|
|
70
|
-
|
|
71
|
-
|
|
72
|
-
|
|
36
|
+
|
|
73
37
|
Dim ChckOn As String
|
|
74
|
-
|
|
75
38
|
Dim ChckOff As String
|
|
76
|
-
|
|
77
|
-
|
|
78
|
-
|
|
39
|
+
|
|
79
40
|
ChckOn = ChrW(9745) '選択状態の文字
|
|
80
|
-
|
|
81
41
|
ChckOff = ChrW(9744) '非選択状態の文字
|
|
82
42
|
|
|
83
|
-
|
|
84
|
-
|
|
85
43
|
'次のxx行は連続しない複数セルの選択時エラーとなる。
|
|
86
|
-
|
|
87
44
|
'dbg
|
|
88
|
-
|
|
89
45
|
ThisWorkbook.WorkSheets(1).Cells(1,4) = Target.CellAddress.Row
|
|
90
|
-
|
|
91
46
|
ThisWorkbook.WorkSheets(1).Cells(1,5) = Target.CellAddress.Column
|
|
92
|
-
|
|
93
47
|
'dbgここまで
|
|
94
|
-
|
|
95
48
|
'対象がA列の指定範囲の1セルだけのとき
|
|
96
|
-
|
|
97
49
|
If Target.CellAddress.Column+1 <> 1 Then Exit Sub
|
|
98
|
-
|
|
99
50
|
If Target.CellAddress.Row+1 > endRow Then Exit Sub
|
|
100
|
-
|
|
101
51
|
If Target.CellAddress.Row+1 < strRow Then Exit Sub
|
|
102
|
-
|
|
103
52
|
If Target.Rows.Count > 1 Then Exit Sub
|
|
104
|
-
|
|
105
53
|
If Target.Columns.Count > 1 Then Exit Sub
|
|
106
|
-
|
|
107
|
-
|
|
108
|
-
|
|
54
|
+
|
|
109
55
|
'Application.EnableEvents = False
|
|
110
|
-
|
|
111
56
|
ThisComponent.LockControllers
|
|
112
|
-
|
|
113
57
|
If Target.CellAddress.Column+1 = 1 Then
|
|
114
|
-
|
|
115
58
|
'チェックあり／チェックなしトグル動作。
|
|
116
|
-
|
|
117
59
|
'チェックありのときは背景は色付き
|
|
118
|
-
|
|
119
60
|
If Target.String = ChckOff Then
|
|
120
|
-
|
|
121
61
|
Target.String = ChckOn
|
|
122
|
-
|
|
123
62
|
With Rows(Target.CellAddress.Row+1).Interior
|
|
124
|
-
|
|
125
63
|
.Color = rgb(255,99,71)
|
|
126
|
-
|
|
127
64
|
End With
|
|
128
|
-
|
|
129
65
|
Else
|
|
130
|
-
|
|
131
66
|
Target.String = ChckOff
|
|
132
|
-
|
|
133
67
|
With Rows(Target.CellAddress.Row+1).Interior
|
|
134
|
-
|
|
135
68
|
.ColorIndex = xlNone
|
|
136
|
-
|
|
137
69
|
End With
|
|
138
|
-
|
|
139
70
|
End If
|
|
140
|
-
|
|
141
71
|
End If
|
|
142
|
-
|
|
143
72
|
|
|
144
|
-
|
|
145
73
|
'Application.EnableEvents = True/False(VBA)に相当する記述が分からない ＆
|
|
146
|
-
|
|
147
74
|
'Target.Offset(0, 1).Select に相当する次の記述は
|
|
148
|
-
|
|
149
75
|
'ThisComponent.CurrentController.select (ThisComponent.CurrentController.ActiveSheet.getCellByPosition(2,Target.CellAddress.Row))
|
|
150
|
-
|
|
151
76
|
'カーソルが動く前にイベントが発生してしまう
|
|
152
|
-
|
|
153
77
|
'Wait 100 'millisec 効果なし
|
|
154
|
-
|
|
155
78
|
'Sleep 100
|
|
156
|
-
|
|
157
79
|
'DoEvents: DoEvents: DoEvents
|
|
158
80
|
|
|
159
|
-
|
|
160
|
-
|
|
161
81
|
ThisComponent.UnlockControllers
|
|
162
|
-
|
|
163
82
|
Exit Sub '終了
|
|
164
83
|
|
|
165
|
-
|
|
166
|
-
|
|
167
84
|
Er:
|
|
168
|
-
|
|
169
85
|
'エラー発生時の処理を記述
|
|
170
|
-
|
|
171
86
|
'msgbox Error ,,"エラー"
|
|
172
|
-
|
|
173
87
|
'dbg
|
|
174
|
-
|
|
175
88
|
ThisWorkbook.WorkSheets(1).Cells(1,3) = "err"
|
|
176
|
-
|
|
177
89
|
ThisWorkbook.WorkSheets(1).Cells(1,2) = ThisWorkbook.WorkSheets(1).Cells(1,2) + 1
|
|
178
|
-
|
|
179
90
|
End Sub
|
|
180
|
-
|
|
181
91
|
'http://calibreblo.blogspot.com/2011/04/blog-post_1621.html
|
|
182
|
-
|
|
183
92
|
'LibreOffice Calc Basic fun!!!: セルの位置を取得
|
|
184
|
-
|
|
185
93
|
'.CellAddress.Column
|
|
186
|
-
|
|
187
94
|
'.CellAddress.Row
|
|
188
|
-
|
|
189
|
-
|
|
190
|
-
|
|
95
|
+
|
|
191
96
|
'http://calibreblo.blogspot.com/2011/04/blog-post_26.html
|
|
192
|
-
|
|
193
97
|
'LibreOffice Calc Basic fun!!!: データが入力されている最終行・最終列を求める
|
|
194
|
-
|
|
195
98
|
'.Rows.Count
|
|
196
|
-
|
|
197
|
-
|
|
198
|
-
|
|
99
|
+
|
|
199
100
|
'https://forum.openoffice.org/ja/forum/viewtopic.php?f=19&t=187
|
|
200
|
-
|
|
201
101
|
'Calcシート内の値があるすべてのセルを範囲とするプロパティ (トピック) • OpenOffice.org コミュニティーフォーラム
|
|
202
|
-
|
|
203
102
|
'.getRows.Count
|
|
204
|
-
|
|
205
103
|
'.getColumns.Count
|
|
206
|
-
|
|
207
|
-
|
|
208
|
-
|
|
104
|
+
|
|
209
105
|
'https://ask.libreoffice.org/en/question/139060/how-to-retrieve-a-cell-value-using-libreoffice-basic/
|
|
210
|
-
|
|
211
106
|
'.Columns.getCount()
|
|
212
|
-
|
|
213
|
-
|
|
214
|
-
|
|
107
|
+
|
|
215
108
|
'https://j11.blog.so-net.ne.jp/2013-10-18
|
|
216
|
-
|
|
217
109
|
'選択範囲の行、列の個数を調べる Libreoffice Calc Basic：ubuntu & LibreOffice：So-netブログ
|
|
218
|
-
|
|
219
110
|
|
|
220
|
-
|
|
221
111
|
'http://calibreblo.blogspot.com/2011/05/blog-post_12.html
|
|
222
|
-
|
|
223
112
|
'LibreOffice Calc Basic fun!!!: セルの背景色とフォントの色を設定する
|
|
224
113
|
|
|
225
|
-
|
|
226
|
-
|
|
227
114
|
'https://forum.openoffice.org/en/forum/viewtopic.php?f=9&t=36641
|
|
228
|
-
|
|
229
115
|
'Custom Cell Background (View topic) • Apache OpenOffice Community Forum
|
|
230
|
-
|
|
231
116
|
'Fill_Cell_Backgrounds.ods by Charlie Young
|
|
232
117
|
|
|
233
|
-
|
|
234
|
-
|
|
235
118
|
'https://stackoverflow.com/questions/32556294/how-to-change-the-background-color-of-a-cell-on-mouse-click-in-libre-office-calc
|
|
236
|
-
|
|
237
119
|
'myCell = ThisComponent.CurrentController.Selection
|
|
238
|
-
|
|
239
120
|
'myCell.CellBackColor = -1
|
|
240
121
|
|
|
241
|
-
|
|
242
|
-
|
|
243
122
|
'https://improve-future.com/libreoffice-calc-basic-handle-cell-range.html
|
|
244
|
-
|
|
245
123
|
'LibreOffice Calc: Basic でセルをまとめて扱う
|
|
246
124
|
|
|
247
|
-
|
|
248
|
-
|
|
249
125
|
'http://itukamuikananoka.blog.fc2.com/blog-category-6.html
|
|
250
|
-
|
|
251
126
|
'LibreOffice - いつか。むいか。なのか。
|
|
252
|
-
|
|
253
127
|
'clearContents で書式のみ消す方法
|
|
254
128
|
|
|
255
|
-
|
|
256
|
-
|
|
257
129
|
'http://www.vbaexpress.com/forum/showthread.php?11740-Solved-colorindex-xlnone
|
|
258
|
-
|
|
259
130
|
'Solved: colorindex = xlnone ?
|
|
260
131
|
|
|
261
|
-
|
|
262
|
-
|
|
263
132
|
'https://forum.openoffice.org/en/forum/viewtopic.php?f=9&t=39266
|
|
264
|
-
|
|
265
133
|
'ActiveCell.Offset (View topic) • Apache OpenOffice Community Forum
|
|
266
|
-
|
|
267
|
-
```
|
|
134
|
+
```
|
|
268
|
-
|
|
135
|
+
9/23追記 改良版
|
|
269
|
-
|
|
136
|
+
```vba
|
|
137
|
+
REM ***** BASIC *****
|
|
138
|
+
Option VBASupport 1
|
|
139
|
+
Option Explicit
|
|
140
|
+
|
|
141
|
+
Dim G_exec, S As Integer
|
|
142
|
+
Dim G_oldticks, G_oldrow, G_oldcol As Long
|
|
143
|
+
|
|
144
|
+
Sub Worksheet_SelectionChanged(ByVal Target As Range)
|
|
145
|
+
'セルの内容を ChckOn / ChckOff に設定した文字に交互に書き換えます
|
|
146
|
+
|
|
147
|
+
'仕様
|
|
148
|
+
'動作するのは対象セルが以下の条件を満たすとき
|
|
149
|
+
'1セル
|
|
150
|
+
'A列
|
|
151
|
+
'strRow行からendRow行まで
|
|
152
|
+
'既に ChckOn / ChckOff が入力されている
|
|
153
|
+
|
|
154
|
+
'制限事項
|
|
155
|
+
'このプログラムはシートイベントの
|
|
156
|
+
'SelectionChangedで駆動することを念頭に作成しましたが、
|
|
157
|
+
'SelectionChangedイベントはマウスクリック時３～４回発火するようです。
|
|
158
|
+
'例：ボタン押下時１回、離した時３回
|
|
159
|
+
'短時間の複数回実行は無視するようになっていますが
|
|
160
|
+
'ボタン押下～離すまで時間が空いたり
|
|
161
|
+
'時刻をうまく取得できなかったときなど
|
|
162
|
+
'不安定な挙動をすることがあります。
|
|
163
|
+
|
|
164
|
+
'dbg
|
|
165
|
+
G_exec = G_exec + 1
|
|
166
|
+
ThisWorkbook.WorkSheets(1).Cells(1,1) = G_exec
|
|
167
|
+
ThisWorkbook.WorkSheets(1).Cells(1,3) = ""
|
|
168
|
+
|
|
169
|
+
On Error Goto Er
|
|
170
|
+
|
|
171
|
+
Const strRow = 2
|
|
172
|
+
Const endRow = 30
|
|
173
|
+
|
|
174
|
+
Dim ChckOn As String
|
|
175
|
+
Dim ChckOff As String
|
|
176
|
+
|
|
177
|
+
ChckOn = ChrW(9745) '選択状態の文字☑
|
|
178
|
+
ChckOff = ChrW(9744) '非選択状態の文字☐
|
|
179
|
+
|
|
180
|
+
|
|
181
|
+
'Main
|
|
182
|
+
Dim dticks, newticks As Long
|
|
183
|
+
Dim newrow, newcol
|
|
184
|
+
Dim oldrow, oldcol
|
|
185
|
+
newticks = getsystemticks()
|
|
186
|
+
dticks = newticks - G_oldticks
|
|
187
|
+
G_oldticks = newticks
|
|
188
|
+
|
|
189
|
+
'If Target.Cells.Count > 1 Then Exit Sub 'Calcではエラー
|
|
190
|
+
If Target.Rows.Count > 1 Then Exit Sub
|
|
191
|
+
If Target.Columns.Count > 1 Then Exit Sub
|
|
192
|
+
If Target.CellAddress.Row+1 > endRow Then Exit Sub
|
|
193
|
+
If Target.CellAddress.Row+1 < strRow Then Exit Sub
|
|
194
|
+
|
|
195
|
+
'dbg
|
|
196
|
+
ThisWorkbook.WorkSheets(1).Cells(1,4) = Target.CellAddress.Row
|
|
197
|
+
ThisWorkbook.WorkSheets(1).Cells(1,5) = Target.CellAddress.Column
|
|
198
|
+
|
|
199
|
+
newrow = Target.CellAddress.Row
|
|
200
|
+
newcol = Target.CellAddress.Column
|
|
201
|
+
oldrow = G_oldrow
|
|
202
|
+
oldcol = G_oldcol
|
|
203
|
+
G_oldrow = newrow
|
|
204
|
+
G_oldcol = newcol
|
|
205
|
+
If Target.CellAddress.Column+1 <> 1 Then Exit Sub
|
|
206
|
+
If dticks<500 then
|
|
207
|
+
If (newrow = oldrow) And (newcol = oldcol) Then exit sub
|
|
208
|
+
End If
|
|
209
|
+
|
|
210
|
+
If Target.String = ChckOff Then
|
|
211
|
+
Target.String = ChckOn
|
|
212
|
+
With Rows(Target.CellAddress.Row+1).Interior
|
|
213
|
+
.Color = rgb(255,99,71)
|
|
214
|
+
End With
|
|
215
|
+
ElseIf Target.String = ChckOn Then
|
|
216
|
+
Target.String = ChckOff
|
|
217
|
+
With Rows(Target.CellAddress.Row+1).Interior
|
|
218
|
+
.ColorIndex = xlNone
|
|
219
|
+
End With
|
|
220
|
+
Else
|
|
221
|
+
'
|
|
222
|
+
End If
|
|
223
|
+
|
|
224
|
+
Exit Sub '終了
|
|
225
|
+
|
|
226
|
+
Er:
|
|
227
|
+
'エラー発生時の処理を記述
|
|
228
|
+
'msgbox Error ,,"エラー"
|
|
229
|
+
'dbg
|
|
230
|
+
ThisWorkbook.WorkSheets(1).Cells(1,3) = "err"
|
|
231
|
+
ThisWorkbook.WorkSheets(1).Cells(1,2) = ThisWorkbook.WorkSheets(1).Cells(1,2) + 1
|
|
232
|
+
End Sub
|
|
233
|
+
|
|
234
|
+
'http://calibreblo.blogspot.com/2011/04/blog-post_1621.html
|
|
235
|
+
'LibreOffice Calc Basic fun!!!: セルの位置を取得
|
|
236
|
+
'.CellAddress.Column
|
|
237
|
+
'.CellAddress.Row
|
|
238
|
+
|
|
239
|
+
'http://calibreblo.blogspot.com/2011/04/blog-post_26.html
|
|
240
|
+
'LibreOffice Calc Basic fun!!!: データが入力されている最終行・最終列を求める
|
|
241
|
+
'.Rows.Count
|
|
242
|
+
|
|
243
|
+
'https://forum.openoffice.org/ja/forum/viewtopic.php?f=19&t=187
|
|
244
|
+
'Calcシート内の値があるすべてのセルを範囲とするプロパティ (トピック) • OpenOffice.org コミュニティーフォーラム
|
|
245
|
+
'.getRows.Count
|
|
246
|
+
'.getColumns.Count
|
|
247
|
+
|
|
248
|
+
'https://ask.libreoffice.org/en/question/139060/how-to-retrieve-a-cell-value-using-libreoffice-basic/
|
|
249
|
+
'.Columns.getCount()
|
|
250
|
+
|
|
251
|
+
'https://j11.blog.so-net.ne.jp/2013-10-18
|
|
252
|
+
'選択範囲の行、列の個数を調べる Libreoffice Calc Basic：ubuntu & LibreOffice：So-netブログ
|
|
253
|
+
|
|
254
|
+
'http://calibreblo.blogspot.com/2011/05/blog-post_12.html
|
|
255
|
+
'LibreOffice Calc Basic fun!!!: セルの背景色とフォントの色を設定する
|
|
256
|
+
|
|
257
|
+
'https://forum.openoffice.org/en/forum/viewtopic.php?f=9&t=36641
|
|
258
|
+
'Custom Cell Background (View topic) • Apache OpenOffice Community Forum
|
|
259
|
+
'Fill_Cell_Backgrounds.ods by Charlie Young
|
|
260
|
+
|
|
261
|
+
'https://stackoverflow.com/questions/32556294/how-to-change-the-background-color-of-a-cell-on-mouse-click-in-libre-office-calc
|
|
262
|
+
'myCell = ThisComponent.CurrentController.Selection
|
|
263
|
+
'myCell.CellBackColor = -1
|
|
264
|
+
|
|
265
|
+
'https://improve-future.com/libreoffice-calc-basic-handle-cell-range.html
|
|
266
|
+
'LibreOffice Calc: Basic でセルをまとめて扱う
|
|
267
|
+
|
|
268
|
+
'http://itukamuikananoka.blog.fc2.com/blog-category-6.html
|
|
269
|
+
'LibreOffice - いつか。むいか。なのか。
|
|
270
|
+
'clearContents で書式のみ消す方法
|
|
271
|
+
|
|
272
|
+
'http://www.vbaexpress.com/forum/showthread.php?11740-Solved-colorindex-xlnone
|
|
273
|
+
'Solved: colorindex = xlnone ?
|
|
274
|
+
|
|
275
|
+
'https://forum.openoffice.org/en/forum/viewtopic.php?f=9&t=39266
|
|
276
|
+
'ActiveCell.Offset (View topic) • Apache OpenOffice Community Forum
|
|
277
|
+
|
|
278
|
+
'https://vbabeginner.net/get-current-datetime-milliseconds/
|
|
279
|
+
'VBAで現在日時をミリ秒単位で取得する ｜ Excel作業をVBAで効率化
|
|
280
|
+
'kernel32 の GetLocalTime や GetSystemTime を使い1秒以下の精度で時刻を取得することもできた
|
|
281
|
+
'本コードでは未使用
|
|
282
|
+
|
|
283
|
+
'https://forum.openoffice.org/en/forum/viewtopic.php?t=103709
|
|
284
|
+
'Apache OpenOffice Community Forum - Selection Change Sheet Event executes 4 times - (View topic)
|
|
285
|
+
'GetSystemTicks()
|
|
286
|
+
```
|
|
270
287
|
|
|
271
288
|
### 試したこと
|
|
272
289
|
|
|
273
|
-
|
|
274
|
-
|
|
275
290
|
Now() で取得した時刻をグローバル変数で保持しておき、前回の実行時刻と今回の実行時刻が一定以下では即終了するようにしてもみましたが、改善はするもののしばしば誤動作しました。
|
|
276
|
-
|
|
277
|
-
（分解能が1秒程度のようで1000ms差になることがある。まれに「今回の実行時刻は前回の-1000ms後」という値も出る
|
|
291
|
+
（分解能が1秒程度のようで1000ms差になることがある。まれに「今回の実行時刻は前回の-1000ms後」という値も出る
|
|
292
|
+
|
|
278
|
-
|
|
293
|
+
9/23追記
|
|
279
|
-
|
|
294
|
+
新たな参考資料(コード末尾に追記)からGetSystemTicks()でより高精度に時刻を取得できることが分かり、完全ではないものの症状が改善された。
|
|
280
295
|
|
|
281
296
|
### 補足情報（FW/ツールのバージョンなど）
|
|
282
297
|
|
|
283
|
-
|
|
284
|
-
|
|
285
298
|
LibreOffice 3.4.6, LibreOffice Portable 4.3.5.2
|
|
286
|
-
|
|
287
299
|
Windows Vista (SPはインストールが成功しない)
|