VBAでテキストボックスのレイアウト設定を操作する
ことごとく「背面」になっているテキストボックスェ……
業務で引き継いだWordドキュメントがカオス……
業務でWordドキュメントを引き継いだ。
で、そのWordドキュメントってのがひどいやつで、
40個ぐらい配置されているテキストボックスのレイアウトがことごとく「背面」
なのだった……。
しかも、そのテキストボックスの中身を書き換えたり、位置を動かしたりしないといけないんだが、
「背面」になっているテキストボックスって、そもそもマウスで選択することすら難しい。
画面右上の「選択」から「オブジェクトの選択」ってのを選ばないと、なかなか選択できなくていらいらする。
こんなのが何十個もあるとか、軽い拷問ですよね。
テキストボックスの「折り返しの種類」をVBAで操作する
「テキストボックスの書式設定」の「レイアウト」タブにある「行内」とか「前面」とかは「折り返しの種類」っていうのね。知らんかった。まあ、Word初心者だしな。
この「折り返しの種類」は、 WrapFormatプロパティというらしい。
オブジェクトの階層をたどると、
Documentオブジェクト→Shapesコレクション→Shapeオブジェクト→WrapFormatオブジェクト→Typeプロパティ
となるのかな。
要するに、コーディング的には、テキストボックスオブジェクトを取得して、そのWrapFormat.Typeプロパティが「前面」になっていなかったら「前面」に変える、というだけで良い。
コーディング
標準モジュールに次のコードを書く。
リスト１ 標準モジュール
Public Sub frontizeTextBox()
Dim objDoc As Document
Set objDoc = ActiveDocument
Dim shp As Word.Shape
For Each shp In objDoc.Shapes '……(1)'
With shp.WrapFormat '……(2)'
If shp.Type = msoTextBox Then '……(3)'
If .Type <> wdWrapFront Then .Type = wdWrapFront '……(4)'
End If
End With
Next
End Sub
プロシージャ名の「frontize」ってのはたぶん存在しない英単語だろうねえ。メンドクサイからテキトーに書いたｗ
それはさておき、まずは、(1)の
For Each shp In objDoc.Shapes
「shp」ってのはShape型のオブジェクト変数で、オートシェイプ（今はそんな呼び方しないんだっけ？）をぶち込むための変数。Shapesコレクションの要素をぶち込んでFor Eachで回していくわけだ。
(2)の
With shp.WrapFormat
では、WrapFormatオブジェクトへの参照や操作が多いのでWithでまとめている。
(3)の
If shp.Type = msoTextBox Then
でshpの中身を調べ、テキストボックスである場合だけ次の処理に進む。
で、shpがテキストボックスだった場合は、(4)の
If .Type <> wdWrapFront Then .Type = wdWrapFront
に進む。
WrapFormatオブジェクトのTypeプロパティがwdWrapFrontでなかったら、wdWrapFrontにする。
ちなみに、wdWrapFrontの正体は
この通り、「3」です。
実行結果
実行前
「折り返しの種類」は「背面」。
実行後
「折り返しの種類」が「前面」になった。
おわりに
たまに、図形の類をベタベタ貼り付けたドキュメントに出くわす。で、それらの設定がことごとくデタラメ、という場面もちょいちょいあるような気がする。そんなとき、VBAで図形を操作する方法を知っていれば便利かも。
まあ、それ以前にもう少しマトモなOfficeの使い方してくれよ……とは思いますが。
ついでに……
オブジェクトブラウザーを使うと、組み込み定数（っていうか、列挙体のメンバ）を調べることができて便利。
コチラは、WdWrapType列挙体のメンバ。名前を見たらだいたい何を意味するのか見当がつくと思います。
直近○回分のイベント発生日時を配列化するFunctionの修正
直近のイベント発生日時を配列化するFunctionの修正
このとき
作成したFunctionについて、対応できるイベントを増やそうとして、いろいろ不具合に気づいたので修正する。
コードへのリンクはコチラ。
１．無意味な判定をやめる
イベントのデータが取得できているかどうかを、
If Not colLoggedEvents.itemIndex(i) Is Nothing Then
で判定しようとしていたが、そもそも該当するイベントがなかったときは、
colLoggedEvents.itemIndex(i)
ここを評価した時点でエラーが出る。
要するに、この判定はまるで無意味だったということになる。
２．イベントのデータが指定した数よりも少なかった場合の対応
たとえば、直近10回分のデータを取得しようとしたのに、データが２個しかなかった、という場合に、
colLoggedEvents.ItemIndex(i)
のところで、
「インデックスが有効範囲にありません。」てやつ。コレクションの要素数を超えているんだから当然だ。
コードの修正
上記１．、２．を踏まえて修正する。
修正前
まず、
Dim i As Integer
Dim tmpDateValues() As Date
ReDim tmpDateValues(0 To eventIndex - 1)
For i = 0 To eventIndex - 1
If Not colLoggedEvents.itemIndex(i) Is Nothing Then
Set objEvent = colLoggedEvents.itemIndex(i)
retTimeWritten = convUTCtoJST(parseTimeWritten(objEvent.TimeWritten))
tmpDateValues(i) = retTimeWritten
End If
DoEvents
Next
getAnyEventDateTime = tmpDateValues
errorHandler:
Set objWMIService = Nothing
Set colLoggedEvents = Nothing
Set objEvent = Nothing
End Function
ここの部分のみ取り上げる。
修正後
Dim i As Integer
Dim tmpDateValues() As Date
Dim n As Integer '……(1)'
n = colLoggedEvents.Count
If n = 0 Then '……(2)'
ReDim tmpDateValues(n)
getAnyEventDateTime = tmpDateValues
Exit Function
End If
If n < eventIndex Then eventIndex = n '……(3)'
ReDim tmpDateValues(0 To eventIndex - 1)
For i = 0 To eventIndex - 1 '……(4)'
Set objEvent = colLoggedEvents.ItemIndex(i)
retTimeWritten = convUTCtoJST(parseTimeWritten(objEvent.timeWritten))
tmpDateValues(i) = retTimeWritten
DoEvents
Next
errorHandler: '……(5)'
getAnyEventDateTime = tmpDateValues
Set objWMIService = Nothing
Set colLoggedEvents = Nothing
Set objEvent = Nothing
End Function
１．への対応
まず、(1)からの２行
Dim n As Integer n = colLoggedEvents.Count
で、変数 n にcolLoggedEventsのCountプロパティの値をぶち込む。
んで、(2)からの５行
If n = 0 Then ReDim tmpDateValues(n) getAnyEventDateTime = tmpDateValues Exit Function End If
で、n が0のとき、すなわち、該当するイベントがなかった場合の対応をする。
要素数１の配列を返り値にしている。特に何も書き込まなくても、1900年1月0日（1899年12月30日）の0時0分0秒がセットされているみたい。
これで、(1)の問題はクリア。
２．への対応
まず、(3)からの２行
If n < eventIndex Then eventIndex = n ReDim tmpDateValues(0 To eventIndex - 1)
で、取得したデータの数が要求した数よりも少ない場合に対応。
「10回分のデータを寄こせ！」と呼び出しても、n すなわちcolLoggedEventsのCountプロパティの値が、たとえば「2」だったら、eventIndexの値を「2」に書き換えてしまうことでエラーの芽を摘む。
そして、即座にReDim。まあ、ここまでムキになってReDimすることもないのでしょうが。
ここまで来たら、(4)からの６行
For i = 0 To eventIndex - 1 Set objEvent = colLoggedEvents.ItemIndex(i) retTimeWritten = convUTCtoJST(parseTimeWritten(objEvent.timeWritten)) tmpDateValues(i) = retTimeWritten DoEvents Next
のForループでは、余計な条件判定は不要。
仮にエラーが出たとしても、(5)の
errorHandler: '……(5)' getAnyEventDateTime = tmpDateValues Set objWMIService = Nothing Set colLoggedEvents = Nothing Set objEvent = Nothing
で、その時点でのtmpDateValuesを返り値として呼び出し元に返すので無問題。
実験
次のコードで呼び出してみる。
Public Sub run()
Call eraseData
Call writeEventDateTime(10, 6008) '……(1)'
End Sub
Public Sub writeEventDateTime(ByVal cnt As Integer, _
ByVal ec As WindowsEventCode)
If cnt > 30 Then cnt = 30
Dim Sh As Worksheet
Set Sh = ThisWorkbook.Worksheets("Main")
Dim baseCell As Range
Dim dateValues As Variant
dateValues = getAnyEventDateTime(cnt, ec)
If dateValues(0) = CDate(0) Then _ '……(2)'
MsgBox "該当するデータがありません。": Exit Sub
Dim i As Integer
With Sh
Set baseCell = .Range("A1")
For i = 1 To UBound(dateValues) + 1 '……(3)'
baseCell.Offset(i, 0).Value = dateValues(i - 1)
Next
End With
End Sub
変えたのは３箇所。
(1)の
Call writeEventDateTime(10, 6008)
では、対象のイベントIDとして6008を指定。
正常にシャットダウンせずに終了、ということらしい。
(2)からの２行（正味１行）
If dateValues(0) = CDate(0) Then _
MsgBox "該当するデータがありません。": Exit Sub
は、該当するイベントデータがなかった場合の対応。
イベントデータが存在しなかった場合、受け取った配列の１番目の要素（インデックス番号「0」の要素）は、日付の初期値のはずなので、この場合はメッセージを表示して終了する。
後は(3)からの３行
For i = 1 To UBound(dateValues) + 1 baseCell.Offset(i, 0).Value = dateValues(i - 1) Next
をこう変えた。Function内部で配列の要素数を変えることがあるので、Uboundで要素数をこの段階で調べる必要がある。
実行結果
10回分要求したが、データは２つしかなかったみたいだ。
ちなみに、第２引数を「7005」にして、
Call writeEventDateTime(10, 6008)
呼び出してみると、
ちゃんとメッセージが表示された。
おわりに
取り扱っているオブジェクトがイメージしにくいものばかりなので、どんなエラーが起こるのか予想しづらいなあ。
今回使用したコード
いちおう、全部載っけときます。
リスト1-1
Public Sub run() Call eraseData Call writeEventDateTime(10, 6008) '///↑第１引数と第２引数を変えれば、いろんなデータを取得して書き込むことができます。' End Sub
リスト1-2
Public Sub writeEventDateTime(ByVal cnt As Integer, _
ByVal ec As WindowsEventCode)
If cnt > 30 Then cnt = 30
Dim Sh As Worksheet
Set Sh = ThisWorkbook.Worksheets("Main")
'///対象のワークシート名を「Main」にしています。'
Dim baseCell As Range
Dim dateValues As Variant
dateValues = getAnyEventDateTime(cnt, ec)
If dateValues(0) = CDate(0) Then _
MsgBox "該当するデータがありません。": Exit Sub
Dim i As Integer
With Sh
Set baseCell = .Range("A1")
For i = 1 To UBound(dateValues) + 1
baseCell.Offset(i, 0).Value = dateValues(i - 1)
Next
End With
End Sub
リスト1-3
Public Sub eraseData()
Dim Sh As Worksheet
Set Sh = ThisWorkbook.Worksheets("Main")
Sh.Range("WriteInArea").Value = ""
'///データ書き込みセル範囲に「WriteInArea」と名前を付けています。'
End Sub
リスト2-1
'///直近○回分のイベント日時を配列化する'
Public Function getAnyEventDateTime( _
ByVal eventIndex As Integer, _
ByVal eventCode As WindowsEventCode) As Date()
On Error GoTo errorHandler
Dim strComputer As String
Dim objWMIService As SWbemServices
Dim colLoggedEvents As SWbemObjectSet
Dim objEvent As SWbemObject
Dim retTimeWritten As Date
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & _
"{impersonationLevel=impersonate}!\\" & _
strComputer & _
"\root\cimv2")
Set colLoggedEvents = _
objWMIService.ExecQuery("SELECT * FROM Win32_NTLogEvent " & _
"WHERE Logfile = 'System' " & _
"AND EventCode = '" & eventCode & "'")
Dim i As Integer
Dim tmpDateValues() As Date
Dim n As Integer
n = colLoggedEvents.Count
ReDim tmpDateValues(0 To eventIndex - 1)
If n = 0 Then
ReDim tmpDateValues(n)
getAnyEventDateTime = tmpDateValues
Exit Function
End If
If n < eventIndex Then eventIndex = n
ReDim tmpDateValues(0 To eventIndex - 1)
For i = 0 To eventIndex - 1
Set objEvent = colLoggedEvents.ItemIndex(i)
retTimeWritten = convUTCtoJST(parseTimeWritten(objEvent.timeWritten))
tmpDateValues(i) = retTimeWritten
DoEvents
Next
errorHandler:
getAnyEventDateTime = tmpDateValues
Set objWMIService = Nothing
Set colLoggedEvents = Nothing
Set objEvent = Nothing
End Function
リスト2-2
Private Function parseTimeWritten(ByVal receiveData As Variant) As Date
parseTimeWritten = _
CDate(Mid(receiveData, 1, 4) & "/" & _
Mid(receiveData, 5, 2) & "/" & _
Mid(receiveData, 7, 2) & _
" " & _
Mid(receiveData, 9, 2) & ":" & _
Mid(receiveData, 11, 2) & ":" & _
Mid(receiveData, 13, 2))
End Function
リスト2-3
Private Function convUTCtoJST(ByVal timeData As Date) As Date
convUTCtoJST = DateAdd("h", 9, timeData)
End Function
「直近○回分のシャットダウン日時」の配列を返すFunction
直近のイベント発生日時を配列化するFunction
このとき
作成したFunctionは、
直近のイベント日時を取得するFunction
だったが、これをちょいと改造して、
直近○回分のイベント日時を取得して配列化するFunction
にする。
改造するポイント
前回のリスト２を再掲する。
前回のリスト２
Public Function getLastEventDateTime( _
ByVal eventCode As WindowsEventCode) As Date '……(1.)'
On Error GoTo errorHandler
Dim strComputer As String
Dim objWMIService As Object
Dim colLoggedEvents As Object
Dim objEvent As Object
Dim retTimeWritten As Date
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & _
"{impersonationLevel=impersonate}!\\" & _
strComputer & _
"\root\cimv2")
Set colLoggedEvents = _
objWMIService.ExecQuery("SELECT * FROM Win32_NTLogEvent " & _
"WHERE Logfile = 'System' " & _
"AND EventCode = '" & eventCode & "'")
If Not colLoggedEvents.itemIndex(0) Is Nothing Then '……(2.)'
Set objEvent = colLoggedEvents.itemIndex(0)
retTimeWritten = convUTCtoJST(parseTimeWritten(objEvent.timeWritten))
getLastEventDateTime = retTimeWritten
End If
errorHandler:
Set objWMIService = Nothing
Set colLoggedEvents = Nothing
Set objEvent = Nothing
End Function
Private Function parseTimeWritten(ByVal receiveData As Variant) As Date
parseTimeWritten = _
CDate(Mid(receiveData, 1, 4) & "/" & _
Mid(receiveData, 5, 2) & "/" & _
Mid(receiveData, 7, 2) & _
" " & _
Mid(receiveData, 9, 2) & ":" & _
Mid(receiveData, 11, 2) & ":" & _
Mid(receiveData, 13, 2))
End Function
Private Function convUTCtoJST(ByVal timeData As Date) As Date
convUTCtoJST = DateAdd("h", 9, timeData)
End Function
改造ポイントは２つ。すなわち、
- 「○回分」を表す引数を追加する
- 必要な数だけループしてイベント日時を取得し、配列にぶち込む
である。
改造したコード
まずは改造後のコードを載せる。
リスト１ 標準モジュール
'///宣言セクション' Public Enum WindowsEventCode osStartUp = 12 osShutDown = 13 winStartUp = 6005 winShutDown = 6006 End Enum '///直近○回分のイベント日時を配列化する' Public Function getAnyEventDateTime( _ ByVal eventIndex As Integer, _ ByVal eventCode As WindowsEventCode) _ As Date() '……(1)' On Error GoTo errorHandler Dim strComputer As String Dim objWMIService As SWbemServices Dim colLoggedEvents As SWbemObjectSet Dim objEvent As SWbemObject Dim retTimeWritten As Date strComputer = "." Set objWMIService = GetObject("winmgmts:" & _ "{impersonationLevel=impersonate}!\\" & _ strComputer & _ "\root\cimv2") Set colLoggedEvents = _ objWMIService.ExecQuery("SELECT * FROM Win32_NTLogEvent " & _ "WHERE Logfile = 'System' " & _ "AND EventCode = '" & eventCode & "'") Dim i As Integer Dim tmpDateValues() As Date '……(2)' ReDim tmpDateValues(0 To eventIndex - 1) For i = 0 To eventIndex - 1 If Not colLoggedEvents.itemIndex(i) Is Nothing Then '……(3)' Set objEvent = colLoggedEvents.itemIndex(i) '……(4)' retTimeWritten = convUTCtoJST(parseTimeWritten(objEvent.TimeWritten)) tmpDateValues(i) = retTimeWritten '……(5)' End If DoEvents Next getAnyEventDateTime = tmpDateValues '……(6)' errorHandler: Set objWMIService = Nothing Set colLoggedEvents = Nothing Set objEvent = Nothing End Function '///日付時刻文字列変換用' Private Function parseTimeWritten(ByVal receiveData As Variant) As Date parseTimeWritten = _ CDate(Mid(receiveData, 1, 4) & "/" & _ Mid(receiveData, 5, 2) & "/" & _ Mid(receiveData, 7, 2) & _ " " & _ Mid(receiveData, 9, 2) & ":" & _ Mid(receiveData, 11, 2) & ":" & _ Mid(receiveData, 13, 2)) End Function '///UTC→JST変換用' Private Function convUTCtoJST(ByVal timeData As Date) As Date convUTCtoJST = DateAdd("h", 9, timeData) End Function
変更箇所についてのみ説明する。
まずは、(1)の
Public Function getAnyEventDateTime( _
ByVal eventIndex As Integer, _
ByVal eventCode As WindowsEventCode) _
As Date()
引数が２つになった。
第１引数のeventIndexで配列に格納する要素数を受け取る。eventIndexという名前にしてしまったが、実際に受け取る数字は要素数なので、インデックス番号最大値＋１。ちょっと分かりにくいかもなあ。
第２引数は前回のまま。WindowsEventCodeという自作列挙体型にしている。列挙体については、現行
Public Enum WindowsEventCode osStartUp = 12 osShutDown = 13 winStartUp = 6005 winShutDown = 6006 End Enum
の４つだけだが、今後随時必要なものを追加していったら良いと思う。
(2)からの２行
Dim tmpDateValues() As Date ReDim tmpDateValues(0 To eventIndex - 1)
では、取得したイベント日時をぶち込むための配列変数tmpDateValueを準備し、すかさず「eventIndex - 1」でReDim。
一旦配列を作成しておいて、最後にこの配列を返り値にする、というおなじみの段取り。
(3)の
If Not colLoggedEvents.itemIndex(i) Is Nothing Then
では、一応取得したコレクションの要素一つ一つについて確認するようにした。別に一つ一つ確認する必要はないようにも思うが……。
(4)の
Set objEvent = colLoggedEvents.itemIndex(i)
で、コレクションの要素を変数objEventにぶち込み、日時をVBAの日付型の形に変換し、JSTに変換したら、(5)の
tmpDateValues(i) = retTimeWritten
で、一旦配列変数tmpDateValuesに格納していく。
このForループを抜けたら、配列は完成しているので、最後に(6)の
getAnyEventDateTime = tmpDateValues
で配列を返り値にしたらおしまい。
使用例
次のような準備をして使ってみる。
こんなふうに、
シートを準備して、セル範囲に「WriteInArea」と名前を付ける。
で、下記のコードで実行してみる。
リスト２ 標準モジュール
'///エントリポイント'
Public Sub run()
Call eraseData
Call writeEventDateTime(30, winShutDown)
End Sub
'///データを取得して書き込む'
Public Sub writeEventDateTime(ByVal cnt As Integer, _
ByVal ec As WindowsEventCode) '……(1)'
If cnt > 30 Then cnt = 30 '……(2)'
Dim Sh As Worksheet
Set Sh = ThisWorkbook.Worksheets("Main")
Dim baseCell As Range
Dim dateValues As Variant '……(3)'
dateValues = getAnyEventDateTime(cnt, ec)
Dim i As Integer
With Sh
Set baseCell = .Range("A1")
For i = 1 To cnt '……(4)'
baseCell.Offset(i, 0).Value = dateValues(i - 1)
Next
End With
End Sub
'///書き込みエリアをクリアする'
Public Sub eraseData()
Dim Sh As Worksheet
Set Sh = ThisWorkbook.Worksheets("Main")
Sh.Range("WriteInArea").Value = ""
End Sub
writeEventDateTimeプロシージャが、データ書き込みのメインの処理。
(1)の
Public Sub writeEventDateTime(ByVal cnt As Integer, _
ByVal ec As WindowsEventCode)
で、２つの引数を設定。
cntは、「○回分のイベント」の「○」の部分。ecは「イベント」の部分。
直近cnt回分のecイベントの日時をセルに書き込んでいくマクロ、ということになる。
(2)の
If cnt > 30 Then cnt = 30
では、第１引数に30を超える数値が渡されたときにcntを「30」にするようにしている。単独のイベントログは30個までっぽいので（真相は知りませんｗ）。
(3)からの２行
Dim dateValues As Variant dateValues = getAnyEventDateTime(cnt, ec)
では、getAnyEventDateTimeの返り値を受け取るためのVariant型変数を準備して、返り値を受け取っている。
あとは、(4)からの３行
For i = 1 To cnt baseCell.Offset(i, 0).Value = dateValues(i - 1) Next
のForループで、一つづつ下へ下へと配列dateValuesの要素を書き込んで行く。
実行結果
エントリポイントのrunプロシージャを実行すると、
この通り、日時が書き込まれた。
おわりに
もし、
職場のPCをシャットダウンする時刻＝職場から出る時刻
みたいな人だったら、
本当の退社時刻
を記録するのに使えるかも。
職場のPCでこのプログラムを実行すると、「へえ、この日はこんなに遅くまで残ってたのか……」とか、「この時期は結構順調だったんだな……」ということが分かって面白かったっす。
追記
あ、今回のリスト１の中で、getAnyEventDateTimeプロシージャの冒頭、変数宣言のところで、しれーっと
Dim strComputer As String Dim objWMIService As SWbemServices Dim colLoggedEvents As SWbemObjectSet Dim objEvent As SWbemObject Dim retTimeWritten As Date
なんて書いちゃってますね。
SWbemServices型とか、SWbemObjectSet型とか、SWbemObject型とか。
これは、
このとき、 id:imihito さんからいただいたコメント、すなわち
ItemIndex の出所は「Microsoft WMI Scripting V 1.2 Library」を参照して、オブジェクトブラウザから「WbemScripting.SWbemObjectSet」を見て貰えれば
に従って、オブジェクトブラウザで調べてみて発見しました。
こいつらがSWbemServicesクラスのメンバ。確かにExecQueryメソッドってのがある。
SWbemObjectSetクラスのメンバ。ItemIndexプロパティがある。
んで、コチラがSWbemObjectクラスのメンバ……って、TimeWrittenプロパティなんてねえぞ！？
でも、フツーに取得できているということは、親クラスから継承しているんでしょうね。たぶん。
ちなみに、（当たり前ですが）参照設定で「Microsoft WMI Scripting Vx.x Library」をオンにしておかないと派手にエラーが出ます。
Join関数について
Join関数というものがある
Join関数
前回の記事
に、 id:imihito さんからコメントをいただいた。曰く、
argsByArray 相当処理として、組み込み関数にJoin 関数というものが有ったりします
```vba
Join(strArray, "！ ")
```
ははは。そういえばそんなのあったなー。またしても、
車輪の再発明
ですよ。はははorz
で、やってみた。
Join関数を使ってみる
とりあえず、次のようなコードでやってみる。
リスト１ 標準モジュール
Public Sub test()
Dim a As Variant
a = Array("アホ", "ボケ", "カス", "デコスケ") '……(1)'
Debug.Print Join(a, "！ ") '……(2)'
End Sub
まず、(1)の
a = Array("アホ", "ボケ", "カス", "デコスケ")
で、Variant型変数の a にArray関数を使って配列をぶち込んでおく。
んで、(2)の
Debug.Print Join(a, "！ ")
でJoin関数の返り値をイミディエイト・ウインドウに表示してみる。
実行結果
この通り、配列の各要素のカンチャンに第２引数の「！ 」を入れてつなげた文字列が出力された。
まるっきりSplit関数の反対なのね。
リスト１改 標準モジュール
ちょっとだけ付け加える。
Public Sub test()
Dim a As Variant
a = Array("アホ", "ボケ", "カス", "デコスケ")
Debug.Print Join(a, "！ ") & "！" '……(*)'
End Sub
(*)の
Debug.Print Join(a, "！ ") & "！"
は、Join関数の返り値に「！」を付け加えている。
実行結果
要するに、
Dim i As Integer
Dim tmp As String
For i = 0 To UBound(a)
If i = 0 Then
tmp = a(i)
Else
tmp = tmp & "！ " & a(i)
End If
Next
tmp = tmp & "！"
Debug.Print tmp
と同じ処理が、わづか３行でできてしまうということだ。
一応、実験。
次のコードで検証する。
リスト２ 標準モジュール
Public Sub test()
Dim a As Variant
a = Array("アホ", "ボケ", "カス", "デコスケ")
Debug.Print Join(a, "！ ") & "！"
Dim i As Integer
Dim tmp As String
For i = 0 To UBound(a)
If i = 0 Then
tmp = a(i)
Else
tmp = tmp & "！ " & a(i)
End If
Next
tmp = tmp & "！"
Debug.Print tmp
End Sub
実行結果
ハイ、全く同じ実行結果でした。
おわりに
またしても、体系的に学んでいない弱みを露呈してしまった。
配列を引数にすることはできるのか
配列を引数にすることはできるのか
配列を引数にしてみる
プロシージャの引数に配列を指定することはできるのだろうか、と思ってやってみた。
とりあえず、
Public Function argsByArray(ByVal ar() As String) As String
としてみたら、
こんなふうにいきなりコンパイル・エラーｗ
配列を引数にするにはByRefにしないといけないらしい。ということはできるんだね。
とりあえず、次のようなFunctionを作ってみた。
リスト１ 標準モジュール
Public Function argsByArray(ByRef ar() As String) As String
Dim n As Integer
n = UBound(ar) '……(1)'
Dim i As Integer
Dim tmp As String
For i = 0 To n '……(2)'
tmp = tmp & ar(i) & "！ "
Next
argsByArray = Left(tmp, Len(tmp) - 1) '……(3)'
End Function
簡単なコードなので、説明するまでもないかも知れないけれど、一応。
(1)の
n = UBound(ar)
で、引数として受け取ったString型の配列 ar() のインデックス番号最大値を変数 n にぶち込む。
(2)からの３行
For i = 0 To n tmp = tmp & ar(i) & "！ " Next
で、配列 ar() の各要素を、後ろに「！ 」（全角感嘆符と全角スペース）を付けて連結し、変数 tmp にぶち込んで行く。
あとは、(3)の
argsByArray = Left(tmp, Len(tmp) - 1)
でLeft関数によって右端の全角スペースを削ってできた文字列を返り値にしておしまい。
実行
次のコードで実行してみる。
リスト２ 標準モジュール
Public Sub testArgsByArray()
Dim strArray() As String
Dim tmpArray As Variant
tmpArray = Array("アホ", "ボケ", "カス") '……1.'
Dim i As Integer
Dim n As Integer
n = UBound(tmpArray) '……2.'
ReDim strArray(0 To n) '……3.'
For i = 0 To n '……4'
strArray(i) = tmpArray(i)
Next
MsgBox argsByArray(strArray()) '……(*)'
End Sub
文字列型の配列を作るのにArray関数が使いたかったので、メッチャ面倒くさいやり方をしている。すなわち、
- Array関数の返り値を一旦Variant型の変数tmpArrayにぶち込む
- できあがった配列tmpArrayのインデックス番号最大値をUBound関数で調べて変数 n にぶち込む。
- 文字列型配列変数strArray()を n でReDimする。
- Forループを使ってtmpArrayの内容をstrArray()に移す
すんません。配列初心者なので、こんな方法しか思いつきませなんだ（←この言い方、横山光輝『三国志』でよく出てくるよね？）。
なんていうか、
strArray(0) = "アホ" strArray(1) = "ボケ" strArray(2) = "カス"
みたいなやり方がイヤだっただけなんですけど。
あとは、(*)の
MsgBox argsByArray(strArray())
で、リスト１のargsByArray関数の返り値をメッセージボックスで表示する。
実行結果
うん。うまく行った。
クエリの「WHERE」の部分の文字列を作るのに使えないかなあ、と思っただけです。ほれ、「OR」とか「AND」でつなぐ条件の数が変化しても、引数が配列だったら対応できるじゃないですか。
直近の起動・終了日時を取得するFunction(2)
直近のイベント日時を取得するFunctionの改良
前回
の続きです。
イベントコードを引数として受け取る
前回は、シャットダウン日時を取得するFunction、起動日時を取得するFunctionの２種類を作ったわけだが、記事中でも言及していたとおり、２つの違いはイベントコードだけなので、イベントコードを引数にして一本化すれば良いのであった。
ついでに、引数のイベントコードは限られたものなので、このときに教えてもらった
引数に列挙体型を指定する裏技
を使うことにした。
リスト１ 標準モジュールの宣言セクション
Public Enum WindowsEventCode winStartUp = 6005 winShutDown = 6006 End Enum
こうしておくことで、Functionの引数に自作の列挙体型を指定することができる。これは便利だ。
リスト２ 標準モジュール
Public Function getLastEventDateTime( _
ByVal eventCode As WindowsEventCode) As Date '……(1)'
On Error GoTo errorHandler
Dim strComputer As String
Dim objWMIService As Object
Dim colLoggedEvents As Object
Dim objEvent As Object
Dim retTimeWritten As Date
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & _
"{impersonationLevel=impersonate}!\\" & _
strComputer & _
"\root\cimv2")
Set colLoggedEvents = _
objWMIService.ExecQuery("SELECT * FROM Win32_NTLogEvent " & _
"WHERE Logfile = 'System' " & _
"AND EventCode = '" & eventCode & "'") '……(2)'
If Not colLoggedEvents.itemIndex(0) Is Nothing Then '……(3)'
Set objEvent = colLoggedEvents.itemIndex(0) '……(4)'
retTimeWritten = convUTCtoJST(parseTimeWritten(objEvent.timeWritten))
getLastEventDateTime = retTimeWritten
End If
errorHandler:
Set objWMIService = Nothing
Set colLoggedEvents = Nothing
Set objEvent = Nothing
End Function
Private Function parseTimeWritten(ByVal receiveData As Variant) As Date
parseTimeWritten = _
CDate(Mid(receiveData, 1, 4) & "/" & _
Mid(receiveData, 5, 2) & "/" & _
Mid(receiveData, 7, 2) & _
" " & _
Mid(receiveData, 9, 2) & ":" & _
Mid(receiveData, 11, 2) & ":" & _
Mid(receiveData, 13, 2))
End Function
Private Function convUTCtoJST(ByVal timeData As Date) As Date
convUTCtoJST = DateAdd("h", 9, timeData)
End Function
まず(1)の
Public Function getLastEventDateTime( _
ByVal eventCode As WindowsEventCode) As Date
WindowsEventCode型の引数を指定している。もちろん、「WindowsEventCode型」というのは自作の列挙体型。
こいつを指定しておくことで、
こんなふうにヒントが出るし、
インテリセンスで入力候補も表示される。メッチャ便利。
ま、イベントコードに該当する数字を渡したら、そのイベントの直近の日時を返してしまうんですがｗ（イベントコード13って何だったっけ？）
んで、(2)の
Set colLoggedEvents = _
objWMIService.ExecQuery("SELECT * FROM Win32_NTLogEvent " & _
"WHERE Logfile = 'System' " & _
"AND EventCode = '" & eventCode & "'")
ExecQueryメソッドの引数のクエリの「AND」以下の部分、
AND EventCode = '6005'
と、イベントコードを直接指定していたのを
AND EventCode = '" & eventCode & "'
と改めただけ。シングルクオートの中身を変数にしただけですな。
こうすることで、１つのプロシージャにまとめることができた。
イベントログコレクションのItemIndexプロパティを使う
さて、今度は、ムダにFor Each ～ Nextを使っていた箇所の改善。
前回、
たとえば、
Set objEvent = colLoggedEvents.Item(1)とかで行けると思ったが、こうするとエラーになった。
などと書いていたのだが、例によって id:imihito さんからの非常にありがたいご指摘が。まさに神の声。
Set objEvent = colLoggedEvents.Item(1)
は
Set objEvent = colLoggedEvents.ItemIndex(0)
とすると上手くいくと思います。
とのこと。
おおっ！ 知らなかった！ ……って、VBAに元からあるコレクションでも何でもないんだから、メンバの表記が違うのが当たり前ですよね。VBAの記法って、ちょっと独特ですから。
また、
ItemIndex の出所は「Microsoft WMI Scripting V 1.2 Library」を参照して、オブジェクトブラウザから「WbemScripting.SWbemObjectSet」を見て貰えれば
ということなので、VBEの「ツール」から「参照設定」を開くと、
ホントだ！ ちゃんとオブジェクトライブラリがあったんだ。
……てことは、変数もObject型にしなくて済むってことか。ほう……。
ともあれ、Itemプロパティではなく、ItemIndexプロパティ、しかも「0」始まり、ということを知ったので、早速(3)のように
If Not colLoggedEvents.itemIndex(0) Is Nothing Then
と書いた。これで、コレクションの１つ目の要素が存在するかどうかで判定ができる。
んで、(4)の
Set objEvent = colLoggedEvents.itemIndex(0)
で変数objEventにコレクションの１つ目をぶち込んで、後は前回と同じ。
もちろん、
With colLoggedEvents
でまとめておいて、
With colLoggedEvents
If Not .itemIndex(0) Is Nothing Then
retTimeWritten = convUTCtoJST(parseTimeWritten(.itemIndex(0).timeWritten))
getLastEventDateTime = retTimeWritten
End If
End With
と書くことも出来たとは思うけれど、慣れ親しんだobjEventさんを抹殺するのも忍びないし、可読性という点でイマイチなので、objEventさんには続投願うことにした。
おわりに
まだまだ知らないことが多いけれど、プログラミングが本当に楽しくなってきたぞ。
id:imihito さん、毎度毎度、本当にありがとうございます!!!!!!!!
直近の起動・終了日時を取得するFunction
Windowsの起動・終了時刻を返すFunction
※改良版はコチラ。
直近の起動・終了時刻を返す
前回の
のリスト１に手を加えて、
- 直近のシャットダウン日時
- 今回の起動日時
を取得するFunctionを作ってみる。
今回作成したコード
とりあえず全体を載っけておく。
リスト１ 標準モジュール
'///リスト1-1' '///直近のWindows起動時刻を返す' Public Function getLastStartUpDateTime() As Date On Error GoTo errorHandler Dim strComputer As String Dim objWMIService As Object Dim colLoggedEvents As Object Dim objEvent As Object Dim retTimeWritten As Date strComputer = "." Set objWMIService = GetObject("winmgmts:" & _ "{impersonationLevel=impersonate}!\\" & _ strComputer & _ "\root\cimv2") Set colLoggedEvents = _ objWMIService.ExecQuery("SELECT * FROM Win32_NTLogEvent " & _ "WHERE Logfile = 'System' AND EventCode = '6005'") If Not colLoggedEvents Is Nothing Then For Each objEvent In colLoggedEvents retTimeWritten = convUTCtoJST(parseTimeWritten(objEvent.timeWritten)) getLastStartUpDateTime = retTimeWritten Exit For Next End If errorHandler: Set objWMIService = Nothing Set colLoggedEvents = Nothing Set objEvent = Nothing End Function '///リスト1-2' '///直近のWindowsシャットダウン時刻を返す' Public Function getLastShutDownDateTime() As Date On Error GoTo errorHandler Dim strComputer As String Dim objWMIService As Object Dim colLoggedEvents As Object Dim objEvent As Object Dim retTimeWritten As Date strComputer = "." Set objWMIService = GetObject("winmgmts:" & _ "{impersonationLevel=impersonate}!\\" & _ strComputer & _ "\root\cimv2") Set colLoggedEvents = _ objWMIService.ExecQuery("SELECT * FROM Win32_NTLogEvent " & _ "WHERE Logfile = 'System' AND EventCode = '6006'") If Not colLoggedEvents Is Nothing Then For Each objEvent In colLoggedEvents retTimeWritten = convUTCtoJST(parseTimeWritten(objEvent.timeWritten)) getLastShutDownDateTime = retTimeWritten Exit For Next End If errorHandler: Set objWMIService = Nothing Set colLoggedEvents = Nothing Set objEvent = Nothing End Function '///リスト1-3' Private Function parseTimeWritten(ByVal receiveData As Variant) As Date parseTimeWritten = _ CDate(Mid(receiveData, 1, 4) & "/" & _ Mid(receiveData, 5, 2) & "/" & _ Mid(receiveData, 7, 2) & _ " " & _ Mid(receiveData, 9, 2) & ":" & _ Mid(receiveData, 11, 2) & ":" & _ Mid(receiveData, 13, 2)) End Function '///リスト1-4' Private Function convUTCtoJST(ByVal timeData As Date) As Date convUTCtoJST = DateAdd("h", 9, timeData) End Function
リスト1-1、1-2がメインの処理をするFunction、リスト1-3、1-4は日付時刻データの整形及び変換に使うFunction。
リスト1-3と1-4については、引数の名前を変えて、インデントを整えただけ。前回から基本的には何も変わっていない。
リスト1-1 直近のWindows起動時刻を返す
Public Function getLastStartUpDateTime() As Date
On Error GoTo errorHandler
Dim strComputer As String
Dim objWMIService As Object
Dim colLoggedEvents As Object
Dim objEvent As Object
Dim retTimeWritten As Date
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & _
"{impersonationLevel=impersonate}!\\" & _
strComputer & _
"\root\cimv2") '……(1)'
Set colLoggedEvents = _
objWMIService.ExecQuery("SELECT * FROM Win32_NTLogEvent " & _
"WHERE Logfile = 'System' AND EventCode = '6005'") '……(2)'
If Not colLoggedEvents Is Nothing Then '……(3)'
For Each objEvent In colLoggedEvents '……(4)'
retTimeWritten = convUTCtoJSC(parseTimeWritten(objEvent.timeWritten))
getLastStartUpDateTime = retTimeWritten
Exit For '……(5)'
Next
End If
errorHandler: '……(6)'
Set objWMIService = Nothing
Set colLoggedEvents = Nothing
Set objEvent = Nothing
End Function
(1)の
Set objWMIService = GetObject("winmgmts:" & _
"{impersonationLevel=impersonate}!\\" & _
strComputer & _
"\root\cimv2")
は、WMIサービスのインスタンスをobjWMIServiceというオブジェクト変数にぶち込んでいるだけ。GetObject関数の引数を少しでも読みやすくするために改行を入れてみた。
(2)も
Set colLoggedEvents = _
objWMIService.ExecQuery("SELECT * FROM Win32_NTLogEvent " & _
"WHERE Logfile = 'System' AND EventCode = '6005'")
前回のコードと同じだが、クエリの部分を大文字にしてそれっぽくしてみたｗ
大きく変えたのはここから。
元のコードでは、ここの条件判定を
If colLoggedEvents.Count > 0 Then
こうしていた。最初はこのままにしていたんだが、全体の処理に異様に時間がかかる。
で、ステップ実行で見ているとここの処理で異様に時間がかかっていた。
Countプロパティの値を参照するためには、イベントログコレクションを全て取得しなくてはならず、そのために時間がかかっているのだと考えた。そこで、上掲(3)の通り、
If Not colLoggedEvents Is Nothing Then
とした。
とにかくcolLoggedEventsコレクションに何かセットされていたらよし、としたわけ。
Object型変数の初期値は「Nothing」だとどこかで見たことがあるので（←裏取れよ）、とりあえずこうした。今のところ、爆速になっている。
で、(4)では
For Each objEvent In colLoggedEvents
の形でcolLoggedEventsコレクションの要素をFor Eachで回すことにしている。
前回の実行結果でもお分かりの通り、イベントログは現在→過去の順に取得しているっぽいので、たとえば、
Set objEvent = colLoggedEvents.Item(1)
とかで行けると思ったが、こうするとエラーになった。
だもんで、ブサイクなのは承知の上で、For Eachのループの中に条件判定も何もなしで(5)のように
Exit For
と書くというマヌケなことに……。
ここは少し改良の余地があるな。
(6)の
errorHandler: Set objWMIService = Nothing Set colLoggedEvents = Nothing Set objEvent = Nothing
は、おなじみのエラーキャッチブロックなんだが、普通だとラベルの直前に書くべき
Exit Function
を書いていない。
Object型という得体の知れない型の変数を用いているので、オブジェクト変数の解放はやるべきだと思ったが、どの道解放するなら処理を２回書かなくても済むと思ったので……。これで問題あるようなら誰か教えてくだされ。
リスト1-2 直近のWindowsシャットダウン時刻を返す
Public Function getLastShutDownDateTime() As Date
On Error GoTo errorHandler
Dim strComputer As String
Dim objWMIService As Object
Dim colLoggedEvents As Object
Dim objEvent As Object
Dim retTimeWritten As Date
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & _
"{impersonationLevel=impersonate}!\\" & _
strComputer & _
"\root\cimv2")
Set colLoggedEvents = _
objWMIService.ExecQuery("SELECT * FROM Win32_NTLogEvent " & _
"WHERE Logfile = 'System' AND EventCode = '6006'")
If Not colLoggedEvents Is Nothing Then
For Each objEvent In colLoggedEvents
retTimeWritten = convUTCtoJSC(parseTimeWritten(objEvent.timeWritten))
getLastShutDownDateTime = retTimeWritten
Exit For
Next
End If
errorHandler:
Set objWMIService = Nothing
Set colLoggedEvents = Nothing
Set objEvent = Nothing
End Function
中身はほとんど同じなので、説明は省略。っていうか、違いはイベントコードの「6005」と「6006」だけなんだから、イベントコードを引数にして一つのFunctionにまとめりゃいいじゃねーか、ということですよね。ははは。
ついでに、日付時刻文字列を整形・変換するコードも分けて載せておく。
リスト1-3 日付時刻文字列を標準の日付時刻形式に変換する
Private Function parseTimeWritten(ByVal receiveData As Variant) As Date
parseTimeWritten = _
CDate(Mid(receiveData, 1, 4) & "/" & _
Mid(receiveData, 5, 2) & "/" & _
Mid(receiveData, 7, 2) & _
" " & _
Mid(receiveData, 9, 2) & ":" & _
Mid(receiveData, 11, 2) & ":" & _
Mid(receiveData, 13, 2))
End Function
リスト1-4 USCをJSTに変換する
Private Function convUTCtoJST(ByVal timeData As Date) As Date
convUTCtoJST = DateAdd("h", 9, timeData)
End Function
実行結果
次のコードで実行する。
リスト２ 標準モジュール
Public Sub testGetWindowsLog() MsgBox "前回シャットダウン日時" & vbCrLf & getLastShutDownDateTime MsgBox "今回起動日時" & vbCrLf & getLastStartUpDateTime End Sub
あれれ？？？ なんかおかしいぞ……。
どうやら、Windows10では、「シャットダウンしたつもりだけれど実はシャットダウンしていない」ということがあるらしい……orz
おわりに
ともあれ、イベントコードを渡せば、直近の当該イベントについてWindowsのログを引っ張ってくることができるようなので、いろいろと応用ができそうですなあ。
