質問編集履歴
2
誤記訂正
title
CHANGED
|
File without changes
|
body
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
135
|
|
|
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
|
-
|
|
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
自決
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -1,144 +1,299 @@
|
|
|
1
|
-
### 前提・実現したいこと
|
|
2
|
-
|
|
3
|
-
[Excelでワンタッチで行チェックする方法](https://okwave.jp/qa/q9518418.html)
|
|
4
|
-
に投稿されたコードをLibreOffice Calcで使用したく修正を行っています。
|
|
5
|
-
シートイベント「選択を変更した時」に登録しているのですが
|
|
6
|
-
ワンクリック毎に複数回実行されてしまうようで動作が不安定です。
|
|
7
|
-
ワンクリック毎に1回だけ実行されるようにするにはどのような方法がありますか？
|
|
8
|
-
|
|
9
|
-
### 発生している問題・エラーメッセージ
|
|
10
|
-
|
|
11
|
-
```
|
|
12
|
-
ワンクリック毎に3、4回実行されてしまうようです。
|
|
13
|
-
チカチカっとなって元に戻る症状は頻発、文字と色が一致しないこともあります。
|
|
14
|
-
```
|
|
15
|
-
|
|
16
|
-
### 該当のソースコード
|
|
17
|
-
|
|
18
|
-
```vba
|
|
19
|
-
REM ***** BASIC *****
|
|
20
|
-
Option VBASupport 1
|
|
21
|
-
Option Explicit
|
|
22
|
-
|
|
23
|
-
Dim G_exec As Integer
|
|
24
|
-
|
|
25
|
-
Sub Worksheet_SelectionChange(ByVal Target As Range)
|
|
26
|
-
|
|
27
|
-
'dbg
|
|
28
|
-
G_exec = G_exec + 1
|
|
29
|
-
ThisWorkbook.WorkSheets(1).Cells(1,1) = G_exec
|
|
30
|
-
ThisWorkbook.WorkSheets(1).Cells(1,3) = ""
|
|
31
|
-
|
|
32
|
-
On Error Goto Er
|
|
33
|
-
|
|
34
|
-
Const strRow = 2
|
|
35
|
-
Const endRow = 30
|
|
36
|
-
|
|
37
|
-
Dim ChckOn As String
|
|
38
|
-
Dim ChckOff As String
|
|
39
|
-
|
|
40
|
-
ChckOn = ChrW(9745) '選択状態の文字
|
|
41
|
-
ChckOff = ChrW(9744) '非選択状態の文字
|
|
42
|
-
|
|
43
|
-
'次のxx行は連続しない複数セルの選択時エラーとなる。
|
|
44
|
-
'dbg
|
|
45
|
-
ThisWorkbook.WorkSheets(1).Cells(1,4) = Target.CellAddress.Row
|
|
46
|
-
ThisWorkbook.WorkSheets(1).Cells(1,5) = Target.CellAddress.Column
|
|
47
|
-
'dbgここまで
|
|
48
|
-
'対象がA列の指定範囲の1セルだけのとき
|
|
49
|
-
If Target.CellAddress.Column+1 <> 1 Then Exit Sub
|
|
50
|
-
If Target.CellAddress.Row+1 > endRow Then Exit Sub
|
|
51
|
-
If Target.CellAddress.Row+1 < strRow Then Exit Sub
|
|
52
|
-
If Target.Rows.Count > 1 Then Exit Sub
|
|
53
|
-
If Target.Columns.Count > 1 Then Exit Sub
|
|
54
|
-
|
|
55
|
-
'Application.EnableEvents = False
|
|
56
|
-
ThisComponent.LockControllers
|
|
57
|
-
If Target.CellAddress.Column+1 = 1 Then
|
|
58
|
-
'チェックあり／チェックなしトグル動作。
|
|
59
|
-
'チェックありのときは背景は色付き
|
|
60
|
-
If Target.String = ChckOff Then
|
|
61
|
-
Target.String = ChckOn
|
|
62
|
-
With Rows(Target.CellAddress.Row+1).Interior
|
|
63
|
-
.Color = rgb(255,99,71)
|
|
64
|
-
End With
|
|
65
|
-
Else
|
|
66
|
-
Target.String = ChckOff
|
|
67
|
-
With Rows(Target.CellAddress.Row+1).Interior
|
|
68
|
-
.ColorIndex = xlNone
|
|
69
|
-
End With
|
|
70
|
-
End If
|
|
71
|
-
End If
|
|
72
|
-
|
|
73
|
-
'Application.EnableEvents = True/False(VBA)に相当する記述が分からない ＆
|
|
74
|
-
'Target.Offset(0, 1).Select に相当する次の記述は
|
|
75
|
-
'ThisComponent.CurrentController.select (ThisComponent.CurrentController.ActiveSheet.getCellByPosition(2,Target.CellAddress.Row))
|
|
76
|
-
'カーソルが動く前にイベントが発生してしまう
|
|
77
|
-
'Wait 100 'millisec 効果なし
|
|
78
|
-
'Sleep 100
|
|
79
|
-
'DoEvents: DoEvents: DoEvents
|
|
80
|
-
|
|
81
|
-
ThisComponent.UnlockControllers
|
|
82
|
-
Exit Sub '終了
|
|
83
|
-
|
|
84
|
-
Er:
|
|
85
|
-
'エラー発生時の処理を記述
|
|
86
|
-
'msgbox Error ,,"エラー"
|
|
87
|
-
'dbg
|
|
88
|
-
ThisWorkbook.WorkSheets(1).Cells(1,3) = "err"
|
|
89
|
-
ThisWorkbook.WorkSheets(1).Cells(1,2) = ThisWorkbook.WorkSheets(1).Cells(1,2) + 1
|
|
90
|
-
End Sub
|
|
91
|
-
'http://calibreblo.blogspot.com/2011/04/blog-post_1621.html
|
|
92
|
-
'LibreOffice Calc Basic fun!!!: セルの位置を取得
|
|
93
|
-
'.CellAddress.Column
|
|
94
|
-
'.CellAddress.Row
|
|
95
|
-
|
|
96
|
-
'http://calibreblo.blogspot.com/2011/04/blog-post_26.html
|
|
97
|
-
'LibreOffice Calc Basic fun!!!: データが入力されている最終行・最終列を求める
|
|
98
|
-
'.Rows.Count
|
|
99
|
-
|
|
100
|
-
'https://forum.openoffice.org/ja/forum/viewtopic.php?f=19&t=187
|
|
101
|
-
'Calcシート内の値があるすべてのセルを範囲とするプロパティ (トピック) • OpenOffice.org コミュニティーフォーラム
|
|
102
|
-
'.getRows.Count
|
|
103
|
-
'.getColumns.Count
|
|
104
|
-
|
|
105
|
-
'https://ask.libreoffice.org/en/question/139060/how-to-retrieve-a-cell-value-using-libreoffice-basic/
|
|
106
|
-
'.Columns.getCount()
|
|
107
|
-
|
|
108
|
-
'https://j11.blog.so-net.ne.jp/2013-10-18
|
|
109
|
-
'選択範囲の行、列の個数を調べる Libreoffice Calc Basic：ubuntu & LibreOffice：So-netブログ
|
|
110
|
-
|
|
111
|
-
'http://calibreblo.blogspot.com/2011/05/blog-post_12.html
|
|
112
|
-
'LibreOffice Calc Basic fun!!!: セルの背景色とフォントの色を設定する
|
|
113
|
-
|
|
114
|
-
'https://forum.openoffice.org/en/forum/viewtopic.php?f=9&t=36641
|
|
115
|
-
'Custom Cell Background (View topic) • Apache OpenOffice Community Forum
|
|
116
|
-
'Fill_Cell_Backgrounds.ods by Charlie Young
|
|
117
|
-
|
|
118
|
-
'https://stackoverflow.com/questions/32556294/how-to-change-the-background-color-of-a-cell-on-mouse-click-in-libre-office-calc
|
|
119
|
-
'myCell = ThisComponent.CurrentController.Selection
|
|
120
|
-
'myCell.CellBackColor = -1
|
|
121
|
-
|
|
122
|
-
'https://improve-future.com/libreoffice-calc-basic-handle-cell-range.html
|
|
123
|
-
'LibreOffice Calc: Basic でセルをまとめて扱う
|
|
124
|
-
|
|
125
|
-
'http://itukamuikananoka.blog.fc2.com/blog-category-6.html
|
|
126
|
-
'LibreOffice - いつか。むいか。なのか。
|
|
127
|
-
'clearContents で書式のみ消す方法
|
|
128
|
-
|
|
129
|
-
'http://www.vbaexpress.com/forum/showthread.php?11740-Solved-colorindex-xlnone
|
|
130
|
-
'Solved: colorindex = xlnone ?
|
|
131
|
-
|
|
132
|
-
'https://forum.openoffice.org/en/forum/viewtopic.php?f=9&t=39266
|
|
133
|
-
'ActiveCell.Offset (View topic) • Apache OpenOffice Community Forum
|
|
134
|
-
```
|
|
135
|
-
|
|
136
|
-
|
|
137
|
-
|
|
138
|
-
|
|
139
|
-
|
|
140
|
-
|
|
141
|
-
|
|
142
|
-
|
|
143
|
-
|
|
1
|
+
### 前提・実現したいこと
|
|
2
|
+
|
|
3
|
+
[Excelでワンタッチで行チェックする方法](https://okwave.jp/qa/q9518418.html)
|
|
4
|
+
に投稿されたコードをLibreOffice Calcで使用したく修正を行っています。
|
|
5
|
+
シートイベント「選択を変更した時」に登録しているのですが
|
|
6
|
+
ワンクリック毎に複数回実行されてしまうようで動作が不安定です。
|
|
7
|
+
ワンクリック毎に1回だけ実行されるようにするにはどのような方法がありますか？
|
|
8
|
+
|
|
9
|
+
### 発生している問題・エラーメッセージ
|
|
10
|
+
|
|
11
|
+
```
|
|
12
|
+
ワンクリック毎に3、4回実行されてしまうようです。
|
|
13
|
+
チカチカっとなって元に戻る症状は頻発、文字と色が一致しないこともあります。
|
|
14
|
+
```
|
|
15
|
+
|
|
16
|
+
### 該当のソースコード
|
|
17
|
+
|
|
18
|
+
```vba
|
|
19
|
+
REM ***** BASIC *****
|
|
20
|
+
Option VBASupport 1
|
|
21
|
+
Option Explicit
|
|
22
|
+
|
|
23
|
+
Dim G_exec As Integer
|
|
24
|
+
|
|
25
|
+
Sub Worksheet_SelectionChange(ByVal Target As Range)
|
|
26
|
+
|
|
27
|
+
'dbg
|
|
28
|
+
G_exec = G_exec + 1
|
|
29
|
+
ThisWorkbook.WorkSheets(1).Cells(1,1) = G_exec
|
|
30
|
+
ThisWorkbook.WorkSheets(1).Cells(1,3) = ""
|
|
31
|
+
|
|
32
|
+
On Error Goto Er
|
|
33
|
+
|
|
34
|
+
Const strRow = 2
|
|
35
|
+
Const endRow = 30
|
|
36
|
+
|
|
37
|
+
Dim ChckOn As String
|
|
38
|
+
Dim ChckOff As String
|
|
39
|
+
|
|
40
|
+
ChckOn = ChrW(9745) '選択状態の文字
|
|
41
|
+
ChckOff = ChrW(9744) '非選択状態の文字
|
|
42
|
+
|
|
43
|
+
'次のxx行は連続しない複数セルの選択時エラーとなる。
|
|
44
|
+
'dbg
|
|
45
|
+
ThisWorkbook.WorkSheets(1).Cells(1,4) = Target.CellAddress.Row
|
|
46
|
+
ThisWorkbook.WorkSheets(1).Cells(1,5) = Target.CellAddress.Column
|
|
47
|
+
'dbgここまで
|
|
48
|
+
'対象がA列の指定範囲の1セルだけのとき
|
|
49
|
+
If Target.CellAddress.Column+1 <> 1 Then Exit Sub
|
|
50
|
+
If Target.CellAddress.Row+1 > endRow Then Exit Sub
|
|
51
|
+
If Target.CellAddress.Row+1 < strRow Then Exit Sub
|
|
52
|
+
If Target.Rows.Count > 1 Then Exit Sub
|
|
53
|
+
If Target.Columns.Count > 1 Then Exit Sub
|
|
54
|
+
|
|
55
|
+
'Application.EnableEvents = False
|
|
56
|
+
ThisComponent.LockControllers
|
|
57
|
+
If Target.CellAddress.Column+1 = 1 Then
|
|
58
|
+
'チェックあり／チェックなしトグル動作。
|
|
59
|
+
'チェックありのときは背景は色付き
|
|
60
|
+
If Target.String = ChckOff Then
|
|
61
|
+
Target.String = ChckOn
|
|
62
|
+
With Rows(Target.CellAddress.Row+1).Interior
|
|
63
|
+
.Color = rgb(255,99,71)
|
|
64
|
+
End With
|
|
65
|
+
Else
|
|
66
|
+
Target.String = ChckOff
|
|
67
|
+
With Rows(Target.CellAddress.Row+1).Interior
|
|
68
|
+
.ColorIndex = xlNone
|
|
69
|
+
End With
|
|
70
|
+
End If
|
|
71
|
+
End If
|
|
72
|
+
|
|
73
|
+
'Application.EnableEvents = True/False(VBA)に相当する記述が分からない ＆
|
|
74
|
+
'Target.Offset(0, 1).Select に相当する次の記述は
|
|
75
|
+
'ThisComponent.CurrentController.select (ThisComponent.CurrentController.ActiveSheet.getCellByPosition(2,Target.CellAddress.Row))
|
|
76
|
+
'カーソルが動く前にイベントが発生してしまう
|
|
77
|
+
'Wait 100 'millisec 効果なし
|
|
78
|
+
'Sleep 100
|
|
79
|
+
'DoEvents: DoEvents: DoEvents
|
|
80
|
+
|
|
81
|
+
ThisComponent.UnlockControllers
|
|
82
|
+
Exit Sub '終了
|
|
83
|
+
|
|
84
|
+
Er:
|
|
85
|
+
'エラー発生時の処理を記述
|
|
86
|
+
'msgbox Error ,,"エラー"
|
|
87
|
+
'dbg
|
|
88
|
+
ThisWorkbook.WorkSheets(1).Cells(1,3) = "err"
|
|
89
|
+
ThisWorkbook.WorkSheets(1).Cells(1,2) = ThisWorkbook.WorkSheets(1).Cells(1,2) + 1
|
|
90
|
+
End Sub
|
|
91
|
+
'http://calibreblo.blogspot.com/2011/04/blog-post_1621.html
|
|
92
|
+
'LibreOffice Calc Basic fun!!!: セルの位置を取得
|
|
93
|
+
'.CellAddress.Column
|
|
94
|
+
'.CellAddress.Row
|
|
95
|
+
|
|
96
|
+
'http://calibreblo.blogspot.com/2011/04/blog-post_26.html
|
|
97
|
+
'LibreOffice Calc Basic fun!!!: データが入力されている最終行・最終列を求める
|
|
98
|
+
'.Rows.Count
|
|
99
|
+
|
|
100
|
+
'https://forum.openoffice.org/ja/forum/viewtopic.php?f=19&t=187
|
|
101
|
+
'Calcシート内の値があるすべてのセルを範囲とするプロパティ (トピック) • OpenOffice.org コミュニティーフォーラム
|
|
102
|
+
'.getRows.Count
|
|
103
|
+
'.getColumns.Count
|
|
104
|
+
|
|
105
|
+
'https://ask.libreoffice.org/en/question/139060/how-to-retrieve-a-cell-value-using-libreoffice-basic/
|
|
106
|
+
'.Columns.getCount()
|
|
107
|
+
|
|
108
|
+
'https://j11.blog.so-net.ne.jp/2013-10-18
|
|
109
|
+
'選択範囲の行、列の個数を調べる Libreoffice Calc Basic：ubuntu & LibreOffice：So-netブログ
|
|
110
|
+
|
|
111
|
+
'http://calibreblo.blogspot.com/2011/05/blog-post_12.html
|
|
112
|
+
'LibreOffice Calc Basic fun!!!: セルの背景色とフォントの色を設定する
|
|
113
|
+
|
|
114
|
+
'https://forum.openoffice.org/en/forum/viewtopic.php?f=9&t=36641
|
|
115
|
+
'Custom Cell Background (View topic) • Apache OpenOffice Community Forum
|
|
116
|
+
'Fill_Cell_Backgrounds.ods by Charlie Young
|
|
117
|
+
|
|
118
|
+
'https://stackoverflow.com/questions/32556294/how-to-change-the-background-color-of-a-cell-on-mouse-click-in-libre-office-calc
|
|
119
|
+
'myCell = ThisComponent.CurrentController.Selection
|
|
120
|
+
'myCell.CellBackColor = -1
|
|
121
|
+
|
|
122
|
+
'https://improve-future.com/libreoffice-calc-basic-handle-cell-range.html
|
|
123
|
+
'LibreOffice Calc: Basic でセルをまとめて扱う
|
|
124
|
+
|
|
125
|
+
'http://itukamuikananoka.blog.fc2.com/blog-category-6.html
|
|
126
|
+
'LibreOffice - いつか。むいか。なのか。
|
|
127
|
+
'clearContents で書式のみ消す方法
|
|
128
|
+
|
|
129
|
+
'http://www.vbaexpress.com/forum/showthread.php?11740-Solved-colorindex-xlnone
|
|
130
|
+
'Solved: colorindex = xlnone ?
|
|
131
|
+
|
|
132
|
+
'https://forum.openoffice.org/en/forum/viewtopic.php?f=9&t=39266
|
|
133
|
+
'ActiveCell.Offset (View topic) • Apache OpenOffice Community Forum
|
|
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
|
+
|
|
288
|
+
### 試したこと
|
|
289
|
+
|
|
290
|
+
Now() で取得した時刻をグローバル変数で保持しておき、前回の実行時刻と今回の実行時刻が一定以下では即終了するようにしてもみましたが、改善はするもののしばしば誤動作しました。
|
|
291
|
+
（分解能が1秒程度のようで1000ms差になることがある。まれに「今回の実行時刻は前回の-1000ms後」という値も出る
|
|
292
|
+
|
|
293
|
+
9/23追記
|
|
294
|
+
新たな参考資料(コード末尾に追記)からGetSystemTicks()でより高精度に時刻を取得できることが分かり、完全ではないものの症状が改善された。
|
|
295
|
+
|
|
296
|
+
### 補足情報（FW/ツールのバージョンなど）
|
|
297
|
+
|
|
298
|
+
LibreOffice 3.4.6, LibreOffice Portable 4.3.5.2
|
|
144
299
|
Windows Vista (SPはインストールが成功しない)
|