Windowsのシャットダウン日時を取得する

Windowsのシャットダウン時刻を取得する

Windwosのイベントログを取得するには？

Excel VBA質問箱 IV【74506】Re:VBAシャットダウン時刻取得にて、次のコードを発見した。

リスト１　標準モジュール

Public Sub test()    '……(1)'
  Call EnumShutdownDateTime(Range("A1"))
End Sub

Public Sub EnumShutdownDateTime(ByVal r As Range)
  Dim strComputer As String    '……(2)'
　Dim objWMIService As Object
　Dim colLoggedEvents As Object
　Dim objEvent As Object
　Dim offsetRow As Long
　Dim tTimeWritten As Date
　　
　strComputer = "."
　Set objWMIService = GetObject("winmgmts:" _
　& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")    '……(3)'
　Set colLoggedEvents = objWMIService.ExecQuery _
　　　("Select * from Win32_NTLogEvent Where Logfile = 'System' and " _
　　　& "EventCode = '6006'")    '……(4)'
　　
　If colLoggedEvents.Count > 0 Then    '……(5)'
　　offsetRow = 0
　　Application.ScreenUpdating = False
　　For Each objEvent In colLoggedEvents    '……(6)'
　　　tTimeWritten = _
　　　　ConvUTCtoJSC(ParseTimeWritten(objEvent.TimeWritten))
　　　r.Offset(offsetRow, 0).Value = tTimeWritten
　　　offsetRow = offsetRow + 1
　　Next objEvent
　　Application.ScreenUpdating = True
　End If
　　
　Set colLoggedEvents = Nothing
　Set objWMIService = Nothing
End Sub

Private Function ParseTimeWritten(ByVal v As Variant) As Date    '……(7)'
　ParseTimeWritten = _
　　CDate(Mid(v, 1, 4) & "/" & Mid(v, 5, 2) & "/" & Mid(v, 7, 2) & _
　　" " & Mid(v, 9, 2) & ":" & Mid(v, 11, 2) & ":" & Mid(v, 13, 2))
End Function

Private Function ConvUTCtoJSC(ByVal d As Date) As Date    '……(8)'
　ConvUTCtoJSC = DateAdd("h", 9, d)
End Function

まず、(1)の

Public Sub test()
	Call EnumShutdownDateTime(Range("A1"))
End Sub

は、エントリポイント。引数にＡ１セルを指定して、EnumShutdownDateTimeを呼んでいるだけ。処理の中身はEnumShutdownDateTimeに書いてある。

んで、そのEnumShutdownDateTimeプロシージャ。

まず、冒頭(2)からの６行

Dim strComputer As String
Dim objWMIService As Object
Dim colLoggedEvents As Object
Dim objEvent As Object
Dim offsetRow As Long
Dim tTimeWritten As Date

変数の宣言。

• strComputer：

  コンピュータ名を格納する。

• objWMIService：

  WMIサービスオブジェクトを格納する。

• colLoggedEvents：

  Windowsのイベントログから拾い出したイベントのコレクションを格納する。

• objEvent：

  colLoggedEventsコレクションの要素を格納する。

• tTimeWritten：

  イベントから取得した日時を格納する。

だいたいこんな用途。

(3)の

Set objWMIService = GetObject("winmgmts:" _
　& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

では、GetObject関数を用いて、WMIサービスオブジェクトを捕まえているっぽい。

「WMI」というのは、コチラによると、

Windows Management Instrumentation

のことらしい。

(ほとんどすべての) Windows リソースへのアクセス、構成、管理、および監視を可能にする管理基盤

だということなので、こいつをゴニョゴニョすれば、Windowsそのもののあれやこれやを取得できるのでしょう（←雑過ぎる理解）。

GetObjectの引数が長ったらしいけど、１行で書くと、

"winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2"

となり、strComputerの値が「.」（このコンピュータ）なので、要するに

"winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2"

ということになるのだろう。

で、

winmgmts:

ってのは、コチラに

GetObjectの第1パラメータとして指定している“winmgmts:”は、ファイル名ではなく、WMIを表す文字列である（Windows Managementsの略だと思われる）。これはURLの先頭で利用するプロトコルを指定する「http:」のようなキーワードだと考えればよい。通常のファイルではない特別な参照方法である。

とあるので、WMIにアクセスするための特別な指定の仕方のようだ。

んで、

{impersonationLevel=impersonate}

について調べてみると、

Constant	value	Description	Google翻訳
Impersonate	3	Allows objects to use the credentials of the caller. This is the recommended impersonation level for Scripting API for WMI calls.	オブジェクトが呼び出し元の資格情報を使用することができます。これはWMI呼び出しのためのスクリプティングAPIの推奨偽装レベルです。

とのこと（コチラをどうぞ）。WMIにアクセスするにあたってのセキュリティレベルか何かを指定しているのだろう。

つまり、objWMIServiceに格納するWMIサービスオブジェクトを取得するのには、次の２点、すなわち、

• ディレクトリの指定にはwinmgmts:という特殊な文字列を使う。
• impersonationLevelを指定する

ことが必要だということ。

このあたり、WSHあたりを勉強した方がいいのかもな。

まだまだ続く。嫌になるなあ。

(4)の

Set colLoggedEvents = objWMIService.ExecQuery _
　　　("Select * from Win32_NTLogEvent Where Logfile = 'System' and " _
　　　& "EventCode = '6006'")

今度は、(3)で取得したWMIサービスオブジェクトのExecQueryメソッドを用いて、colLoggedEventsにイベントの集合を格納している（のだと思う。自分でもよく分かっていないｗ）。

ExecQueryメソッドの引数は、１行で書くと

"Select * from Win32_NTLogEvent Where Logfile = 'System' and EventCode = '6006'"

ということなので、つまりはSQLのクエリを投げているってことですか？？？

「Win32_NTLogEvent」というテーブルから、「LogFile」フィールドの値が「'System'」かつ「EventCode」フィールドの値が「6006」のレコードを引っ張って来い、ということでしょうか。

SQLは全くの素人なので、間違えていたら親切に教えろてくだされ。

とまれ、これでcolLoggedEventsにはイベントログの集合体が格納されていることになるのだろう。

「EventCode」の「6006」ってのは「シャットダウン」を指すので、colLoggedEventsにはシャットダウンイベントに関する記録が格納されていることになる（んだよね？）。

(5)の

If colLoggedEvents.Count > 0 Then

による条件判定は、colLoggedEventsコレクション（？）のCountプロパティを用いている。Countプロパティの値が０よりも大きいということは、何らかのイベントが取得できているということだからこうしているのだろう。

(6)からの６行（実質は５行）

For Each objEvent In colLoggedEvents
  tTimeWritten = _
    ConvUTCtoJSC(ParseTimeWritten(objEvent.TimeWritten))
  r.Offset(offsetRow, 0).Value = tTimeWritten
  offsetRow = offsetRow + 1
Next objEvent

では、colLoggedEventsコレクションの中身について、まず、

tTimeWritten = ConvUTCtoJSC(ParseTimeWritten(objEvent.TimeWritten))

でコレクションの要素（objEvent）のTimeWrittenプロパティから取得した日時（を表す文字列）を、(7)のParseTimeWritten関数を用いて標準の日付時刻形式に変換し、その上で(8)のConvUTCtoJSC関数で日本の時刻に変換している。

TimeWrittenプロパティから取得できる値が、例えば「2017年11月4日の15時37分00秒」だと20171104153700という何とも気の利かない形であること、及び

「UTC（協定世界時）」とは、世界各地の標準時を決めるときの基準となる「世界標準時」のことです。たとえば日本の標準時（JST）は「UTC」よりも 9時間進んでいるため「UTC+09:00」と表示されます。

ということ（コチラより）から、二重に変換せねばならん。ああめんどくさい。

まあ、そんなわけで、

tTimeWritten = ConvUTCtoJSC(ParseTimeWritten(objEvent.TimeWritten))

を通過した後、変数tTimeWrittenには、めでたくシャットダウンイベントの起きた日時が格納されているのだ。

あとは、

r.Offset(offsetRow, 0).Value = tTimeWritten

で１回目ならoffsetRowが「0」なのでＡ１セルにtTimeWrittenに格納されている日時を書き込み、

offsetRow = offsetRow + 1

でoffsetRowをインクリメントして次のループへ。

よって、Ａ１セルからスタートして、下へ下へシャットダウン日時を書き込んで行くことになる。

ついでに、(7)の

Private Function ParseTimeWritten(ByVal v As Variant) As Date
　ParseTimeWritten = _
　　CDate(Mid(v, 1, 4) & "/" & Mid(v, 5, 2) & "/" & Mid(v, 7, 2) & _
　　" " & Mid(v, 9, 2) & ":" & Mid(v, 11, 2) & ":" & Mid(v, 13, 2))
End Function

は、colLoggedEventsコレクションの要素のTimeWrittenプロパティから取得した日付時刻文字列をDate型の形に整形してDate型に変換するFunction。Mid関数を使った非常に原始的な処理だ。

あと、(8)の

Private Function ConvUTCtoJSC(ByVal d As Date) As Date
　ConvUTCtoJSC = DateAdd("h", 9, d)
End Function

は単純至極。TimeWrittenプロパティで取得した時刻を９時間進めることによって、UTCをJSCに変換している。

実行結果

エントリポイントであるtestプロシージャを実行すると、

こんなふうに、シャットダウン日時が上から下へと書き込まれた。

おわりに

WMIとか、初めて手を出したのだが、このあたりをしっかり勉強したらかなり面白いことができそうな気がしてきた。

今回は、人のコードを自分なりに説明しただけ、という形になってしまったが、ちょっとづつ分かってきたので、自分なりに手を加えていこうと思う。

追記

Function化しました。

akashi-keirin.hatenablog.com

タブ幅やタブ位置をVBAから設定する

VBAからタブを設定する

既定のタブ幅をVBAで操る

タブ幅の設定って、結構めんどくさいなあと思っていた。んで、何とかVBAで操作できないものか、とちょっとggってみたんだが、これというものが見つからず（調べ方が悪いだけだと思うけど）、ちょいとマクロ記録をやってみた。

「段落」のところの右下隅っこをクリック。

一番下の「タブ設定」をクリック。

「既定値」のところのスピンボタンをクリックして、

「既定値」を「3 字」にする。

生成されたコードがコレ。

一応、コードも載せておくと、

Sub Macro1()
' Macro1 Macro'
  With Selection.ParagraphFormat
    .LeftIndent = MillimetersToPoints(0)
    .RightIndent = MillimetersToPoints(0)
    .SpaceBefore = 0
    .SpaceBeforeAuto = False
    .SpaceAfter = 0
    .SpaceAfterAuto = False
    .LineSpacingRule = wdLineSpaceSingle
    .Alignment = wdAlignParagraphJustify
    .WidowControl = False
    .KeepWithNext = False
    .KeepTogether = False
    .PageBreakBefore = False
    .NoLineNumber = False
    .Hyphenation = True
    .FirstLineIndent = MillimetersToPoints(0)
    .OutlineLevel = wdOutlineLevelBodyText
    .CharacterUnitLeftIndent = 0
    .CharacterUnitRightIndent = 0
    .CharacterUnitFirstLineIndent = 0
    .LineUnitBefore = 0
    .LineUnitAfter = 0
    .MirrorIndents = False
    .TextboxTightWrap = wdTightNone
    .CollapsedByDefault = False
    .AutoAdjustRightIndent = True
    .DisableLineHeightGrid = False
    .FarEastLineBreakControl = True
    .WordWrap = True
    .HangingPunctuation = True
    .HalfWidthPunctuationOnTopOfLine = False
    .AddSpaceBetweenFarEastAndAlpha = True
    .AddSpaceBetweenFarEastAndDigit = True
    .BaseLineAlignment = wdBaselineAlignAuto
  End With
  Selection.ParagraphFormat.TabStops.ClearAll
  ActiveDocument.DefaultTabStop = MillimetersToPoints(11.1)
End Sub

思わずうげっとなりそうなコード。

こんなにたくさんのプロパティが関わっているとは……。

ただ、落ち着いてよ～く見ると、タブ設定に関係していそうなのは

Selection.ParagraphFormat.TabStops.ClearAll
ActiveDocument.DefaultTabStop = MillimetersToPoints(11.1)

ラスト２行のここだけっぽい。

要するに、

DocumentオブジェクトのDefaultTabStopプロパティ

で決まっているっぽいのだ。

右辺の

MillimetersToPoints(11.1)

ってのがよく分からんかったんだが、

なるほどね……。

「文字のポイント数×字数」を指定すれば、

○○文字分のタブ幅

にできるということだ。

文書全体の既定のタブ幅を設定するコード

リスト１　標準モジュール

Public Sub tabTest()
  ActiveDocument.DefaultTabStop = 10.5 * 6
End Sub

なんと、たったのこれだけ。

ActiveDocumentのDefaultTabStopプロパティに10.5ポイント６文字分の数値を指定する。

実行結果

こんなふうにタブを指定した段落を選択。既定のタブ幅が３字なのに、「大津びわこ」という５字の文字列や「向日町」、「和歌山」という３字の文字列があるので、それらの単語のところで間隔がちょっとおかしくなっている。

この段落を選択してリスト１を実行すると、

ほれ、この通り。タブ幅を最大文字数プラス１にしたことで、非常に美しく整列した。

段落のタブ位置をVBAで設定する

今度は、段落のタブ位置の設定をやってみる。

めんどくさいので、今度はいきなりコードを載せる。

リスト２　標準モジュール

Public Sub tabStopsTest()
  Dim fontSize As Single
  fontSize = Selection.Font.Size    '……(1)'
  Dim i As Integer
  With Selection.ParagraphFormat    '……(2)'
    .TabStops.ClearAll    '……(*)'
    For i = 1 To 4    '……(3)'
      .TabStops.Add Position:= i * (fontSize * 6)
    Next
    .TabStops.Add Position:=fontSize * 45, _
                  Alignment:=wdAlignTabRight, _
                  Leader:=wdTabLeaderMiddleDot    '……(4)'
  End With
End Sub

(1)の

fontSize = Selection.Font.Size

では、選択位置のフォントサイズを取得して変数fontSizeに格納している。

後で出てくるTabStopsコレクションのAddメソッドの引数Positionは、タブ位置をポイント数で指定するので、フォントサイズを変数に入れておくことで可読性が上がると思った。

(2)からの９行（実質７行）、

With Selection.ParagraphFormat
  .TabStops.ClearAll    '……(*)'
  For i = 1 To 4    '……(3)'
    .TabStops.Add Position:= i * (fontSize * 6)
  Next
  .TabStops.Add Position:=fontSize * 45, _
                Alignment:=wdAlignTabRight, _
                Leader:=wdTabLeaderMiddleDot    '……(4)'
End With

は、SelectionオブジェクトからParagraphFormatオブジェクトへとたどって行き、そのTabStopsコレクションに対する処理。

(*)で一旦タブ位置をクリア。

めんどくさいから画像は載せないけれど、(*)の直後に

Debug.Print .TabStops.Count

としてTabStopsコレクションの要素数を調べてみると、イミディエイトに「7」と表示されたので、TabStopオブジェクトが消え去ったわけではないっぽい。

んで、(3)からの３行

For i = 1 To 4    '……(3)'
  .TabStops.Add Position:= i * (fontSize * 6)
Next

で、TabStopsコレクションのAddメソッドを用いて６字分おきに４つのTabStopを設定する。

Addメソッドで引数Positionだけを設定した場合は左タブ・タブリーダなしになるらしい。

TabStopsコレクションのAddメソッドには引数が３つあるので、その挙動をご覧に入れるべく、(4)の

.TabStops.Add Position:=fontSize * 45, _
              Alignment:=wdAlignTabRight, _
              Leader:=wdTabLeaderMiddleDot

を追加したというわけ。

引数Alignmentによって、左揃え、右揃えなどを指定し、
引数Leaderによってタブリーダの種類を指定する。

ちなみに、タブリーダの種類を表す定数は、

こんな感じです。

上掲のコードでは、

• 45 字の位置に
• 右揃えタブ
• タブリーダは中点

というふうになっている。

実行結果

こんなふうにタブを挿入した段落を選択し、マクロを実行。

こんなふうにタブ位置が設定されている。

バッチリ設定されている。

これ、一つ一つ設定するのってめんどくさいんですよねー。

タブ位置をラクラク設定できるようなアドインでも作ってみるかなー。

ちょっと疑問

ココで、

TabStopsコレクションの要素数を調べてみると、イミディエイトに「7」と表示された

と書いたんだけれど、

なんで７なんだ？？？？？？？？

５つしかTabStopなんて設定していないはずなのに……。

@akashi_keirin on Twitter

乱数を格納した配列を保持するクラスを作ってみた

乱数を格納した配列を保持するクラス

クラスへの移行

前回の

akashi-keirin.hatenablog.com

で、乱数を格納した配列を作るFunctionを作った。

実は、追記のところで、型指定でVariantを使うブサイクさ問題は解決ずみなんだが、乗りかかった船なのでやっておく。

まあ、クラスにしておけば、ひとたび生成した乱数保持配列をインスタンスごとに持たせておくことで複数使い回せる、というメリットがありそうだし（相変わらず使いどころは不明ですがｗ）。

ともかく、まずはクラスを作る。

リスト１　クラスモジュール

オブジェクト名は「RandomMaker」としている。

Option Explicit

'Fields'
Private randomIndex_() As Integer    '……(1)'

'Getter'
Public Property Get randomIndex(ByVal i As Integer) As Integer    '……(2)'
  randomIndex = randomIndex_(i)
End Property

'methods'
Public Sub setRandomArray(ByVal maxNum As Integer, _
                      ByVal allowDuplicate As Boolean)
  Dim flg() As Boolean
  ReDim flg(maxNum - 1)
  Dim i As Integer
  ReDim randomIndex_(maxNum - 1)
  Randomize
  Dim tmp As Integer
  For i = 0 To maxNum - 1
    Do
      tmp = Int(maxNum * Rnd + 1)
    '///乱数：Int((最大値 - 最小値 + 1) * Rnd + 最小値)'
    Loop Until flg(tmp - 1) = False
    randomIndex_(i) = tmp
    If Not allowDuplicate Then flg(tmp - 1) = True
  Next
End Sub

(1)の

Private randomIndex_() As Integer

は、配列保持用の変数。

(2)からの３行、

Public Property Get randomIndex(ByVal i As Integer) As Integer    '……(2)'
  randomIndex = randomIndex_(i)    '……(*)'
End Property

は、Getterメソッドに相当するもの。

akashi-keirin.hatenablog.com

のときにも書いたが、インスタンスに配列を持たせる形にしているけれど、プロパティとして配列を持っているわけではなく、プロパティを参照するときには、配列のインデックス番号を引数として渡して、内部の配列からその値を受け取ってプロパティの値を返す、という形になっているみたい。

だから、２行目の左辺には

randomIndex = randomIndex_(i)

のように、「(i)」が付かない、ということになる。

メソッド部分は何も変えていないので、説明は省略。

実行

次のコードでクラスを使用してみる。

せっかくなので、今度は

文字単位でランダムに並べ替えるマクロ

にしてみた。

リスト２　標準モジュール

Public Sub randomSortByCharacter()
  Dim num As Integer
  Dim charArray() As String
  With Selection
    num = .Characters.Count
    ReDim charArray(num - 1)
    Dim i As Integer
    For i = 0 To num - 1
      charArray(i) = .Characters(i + 1)
    Next
  End With
  Dim randMaker As RandomMaker    '……(1)'
  Set randMaker = New RandomMaker
  Dim str As String
  With randMaker
    .setRandomArray num, False    '……(2)'
    For i = 0 To num - 1    '……(3)'
      str = str & charArray(.randomIndex(i) - 1)
    Next
  End With
  Selection.TypeText Text:=str
End Sub

操作の対象をSelectionオブジェクトのWordsコレクションからCharactersコレクションに変更しただけ。

あとは、(1)からの２行

Dim randMaker As RandomMaker
Set randMaker = New RandomMaker

でRandomMakerクラスのインスタンスを変数randMakerにぶち込んで、

(2)の

randMaker.setRandomArray num, False

で乱数を格納した配列を持たせ、

(3)の

For i = 0 To num - 1    '……(3)'
  str = str & charArray(.randomIndex(i) - 1)
Next

でRandomMakerクラスのrandomIndexプロパティを利用して文字を再構成して元の場所に上書きする。

実行結果

こんなふうに範囲指定して実行すると、

こんな感じ。

こんなふうに範囲指定して実行すると、

こんな感じになる。

おわりに

使い道はこれから考える。

追記

改良しました。

akashi-keirin.hatenablog.com

乱数を格納した配列を作るFunction

文字をランダムに並べ替える

乱数を作るのはめんどくさい

ランダムに並べ替えるという作業をするときには、乱数を発生させて使えば良いのだが、毎度毎度乱数を発生させる処理を書くのは正直メンドクサイ。

最大数を与えたら、１～最大数をランダムに並べて配列にぶち込んでくれるような関数でもあれば、その配列を０～最大数マイナス１の順で呼び出してコレクションのインデックスにすることによって、コレクションをランダムに並べ替えて出力することが可能になると考えた。

ランダムに並べ替えて配列にぶち込むFunction

リスト１　標準モジュール

Public Function createRandomArray( _
                  ByVal maxNum As Integer, _
                  ByVal allowDuplicate As Boolean) _
                    As Variant    '……(1)'
  Dim flg() As Boolean
  ReDim flg(maxNum - 1)    '……(2)'
  Dim i As Integer
  Dim retArray() As Integer    '……(3)'
  ReDim retArray(maxNum - 1)
  Randomize
  Dim tmp As Integer
  For i = 0 To maxNum - 1
    Do
      tmp = Int(maxNum * Rnd + 1)    '……(4)'
    '///乱数：Int((最大値 - 最小値 + 1) * Rnd + 最小値)'
    Loop Until flg(tmp - 1) = False    '……(5)'
    retArray(i) = tmp    '……(6)'
    If Not allowDuplicate Then flg(tmp - 1) = True    '……(7)'
  Next
  createRandomArray = retArray    '……(8)'
End Function

ちょっとめんどくさいけれど、自分の備忘のためにも説明を書いておく。

(1)の

Public Function createRandomArray( _
                  ByVal maxNum As Integer, _
                  ByVal allowDuplicate As Boolean) _
                    As Variant

引数maxNumは最大数。たとえば、こいつを10にしたら、１～10までをランダムに取り出して要素数10の配列にぶち込んでいくということ。

引数allowDuplicateは、番号の重複を許可するかどうか。Trueにすると重複無しで配列を作成。Falseにすると重複ありで配列を作成することになる。Falseを指定する場面があるのかどうかは不明。

返り値の型はVariantにした。最初Integerにしていたんだけれど、「型が一致しません」エラーが出て対応策が分からなかったので。

(2)の

ReDim flg(maxNum - 1)

では、引数で渡されたmaxNumを用いて配列変数flgをRedimしている。はじめから

Dim flg(maxNum - 1) As Boolean

でうまく行きそうなもんだが、こうすると「定数式が必要です」エラーが出る。

(3)の

Dim retArray() As Integer

は、返り値用の配列変数。createRandomArrayを配列みたいにして直接値をぶち込んで行くことができないので、一旦配列を作っておいて、完成後この配列を返す、という形を取る。

(4)の

tmp = Int(maxNum * Rnd + 1)

で、一旦１～maxNumの範囲の整数をランダムに生み出して変数tmpに格納する。

(5)の

Loop Until flg(tmp - 1) = False

でDo～Loopの終了条件を指定している。

たとえば、tmpに10が入っているとすると、flg(10-1)、すなわち配列変数flg()の10番目の要素がfalseだったらループを抜けるということ。

ループを抜けると、(6)の

retArray(i) = tmp

で配列変数retArrayにtmpの値をぶち込み、(7)の

If Not allowDuplicate Then flg(tmp - 1) = True

で、重複を許可しない場合に限ってflg(tmp - 1)、すなわちtmpが10の場合は配列変数flg()の10番目をTrueに変える。

こうすることで、この後仮に(4)で10がtmpに代入されたとしても、(5)のループ終了条件を満たさなくなる。すなわち、この後10が配列変数retArrayの要素になることはないということ。

こうして、Forループが終了すると配列変数retArrayには１～maxNumまでの整数がランダムにぶち込まれていることになるので、後は(8)の

createRandomArray = retArray

で配列retArrayを返しておしまい。

実行

標準モジュールに下記のコードを書いて実行してみる。

リスト２　標準モジュール

Public Sub test()
  Dim a As Variant
  a = createRandomArray(10, False)
  Dim i As Integer
  For i = 0 To 9
    Debug.Print a(i)
  Next
End Sub

この通り、無事に1～10が重複無しのランダムに並んでいる。

選択範囲の単語をランダムに並べ替える

自作Function「createRandomArray」を利用して、選択範囲の単語をランダムに並べ替えるマクロを作ってみる。

リスト３　標準モジュール

Public Sub randomSortByWord()
  Dim num As Long
  Dim wordsArray() As String
  With Selection
    num = .Words.Count    '……(1)'
    ReDim wordsArray(num - 1)    '……(2)'
    Dim i As Integer
    For i = 0 To num - 1    '……(3)'
      wordsArray(i) = .Words(i + 1)
    Next
  End With
  Dim wordsOrder As Variant
  wordsOrder = createRandomArray(num, False)    '……(4)'
  Dim str As String
  For i = 0 To num - 1    '……(5)'
    str = str & wordsArray(wordsOrder(i) - 1)
  Next
  Selection.TypeText Text:=str    '……(6)'
End Sub

(1)の

num = .Words.Count

では、変数numにSelectionオブジェクト（この場合は選択範囲）のWordsコレクションのCountプロパティを参照することで選択範囲の「単語数」を取得し、変数numにぶち込んでいる。

(2)では、(1)で得られた単語数をもとに配列変数wordsArray()をRedim。

(3)からの３行

For i = 0 To num - 1    '……(3)'
  wordsArray(i) = .Words(i + 1)
Next

で、一旦選択範囲の各単語を配列に格納。配列のインデックスは0から始まるけれど、Wordsコレクションのインデックスは1から始まるので、Wordsコレクションのインデックスのところは「i + 1」になる。

(4)の

wordsOrder = createRandomArray(num, False)

では、単語を取り出す順番を格納する配列変数wordsOrderにcreateRandomArray関数の返り値を格納。

これで配列変数wordsOrderには１～単語数のそれぞれの数字がランダムな順番で格納されることになる。

(5)からの３行

For i = 0 To num - 1    '……(5)'
  str = str & wordsArray(wordsOrder(i) - 1)
Next

では、変数strに配列変数wordsArrayに格納されている単語を１つづつ配列変数wordsOrderの要素で指定して取り出し、連結していく。

Forループが終了した時点で、strには、単語をランダムに並べ替えた文字列が完成していることになる。

んで最後に(6)の

Selection.TypeText Text:=str

で、SelectionオブジェクトのTypeTextメソッドを用いてstrに格納された文字列を書き込んでおしまい。

SelectionオブジェクトのTypeTextメソッドは、文字列が選択された状態で実行すると、選択範囲を引数Textで指定された文字列で上書きする。

実行結果

こんなふうに文字列を選択状態にして実行すると、

このようになる。

悲しいかな、「単語」と言っても、「Wordが認識する単語」に過ぎず、結果はめちゃくちゃである。

おわりに

今回はFunctionでやってみたが、Functionの返り値がVariant型になってしまったり、その結果、呼び出す側でも変数をVariantにしないといけないというのは何ともブサイクなので、イマイチだなあと思ってしまう。

クラスにした方がキレイに書けるかも知れない。

相変わらず使い道があるのかどうかはよく分からないｗ

@akashi_keirin on Twitter

追記

例によってid:imihito さんからアドヴァイスをいただいた。

返り値の型を
`As Integer()`
のように後ろに丸括弧を付けた形にすることで指定した型の配列を返すことができます。

とのこと。

早速、上掲のリスト１とリスト２を、次のように書き換えてみた。

リスト１改　標準モジュール

Public Function createRandomArray( _
                  ByVal maxNum As Integer, _
                  ByVal allowDuplicate As Boolean) _
                    As Integer()    '……(*)'
  Dim flg() As Boolean
  ReDim flg(maxNum - 1)
  Dim i As Integer
  Dim retArray() As Integer
  ReDim retArray(maxNum - 1)
  Randomize
  Dim tmp As Integer
  For i = 0 To maxNum - 1
    Do
      tmp = Int(maxNum * Rnd + 1)
    '///乱数：Int((最大値 - 最小値 + 1) * Rnd + 最小値)'
    Loop Until flg(tmp - 1) = False
    retArray(i) = tmp
    If Not allowDuplicate Then flg(tmp - 1) = True
  Next
  createRandomArray = retArray
End Function

(*)のところで、返り値の型指定を

As Integer()

にしました。

リスト２改　標準モジュール

Public Sub randomSortByWord()
  Dim num As Long
  Dim wordsArray() As String
  With Selection
    num = .Words.Count
    ReDim wordsArray(num - 1)
    Dim i As Integer
    For i = 0 To num - 1
      wordsArray(i) = .Words(i + 1)
    Next
  End With
  Dim wordsOrder() As Integer    '……(*)'
  wordsOrder = createRandomArray(num, False)
  Dim str As String
  For i = 0 To num - 1
    str = str & wordsArray(wordsOrder(i) - 1)
  Next
  Selection.TypeText Text:=str
End Sub

こちらも(*)の部分、createRandomArrayの返り値を受け取る変数wordsOrderの宣言を

Dim wordsOrder() As Integer

このようにIntegerの配列型にしました。

結果

無事、実行できました。

毎度毎度のことながら、id:imihito さん、

ありがとうございました!!!!!!!!(*´∀`)

ユーザーフォームへのコントロールの動的配置

コンボボックスを動的に追加する

フォームにコンボボックスを追加する

コンボボックスやリストボックスは、ユーザからの入力を受け付けるインターフェースとしては便利なんだが、チマチマ作ることを思うと結構メンドクサイ。

コンボボックスの追加がラクにできたらいいなあ、と思い、ちょっと実験してみた。

まずは、フォームを挿入する。今回はオブジェクト名を「FormTest02」としてある。

リスト１　フォームモジュール

Private srcRange_() As Range    '……(*)'
Private cmbBox_() As MSForms.ComboBox
Private numOfCombos_ As Integer

Public Sub createComboBox( _
             ByVal posTop As Double, _
             ByVal posLeft As Double, _
             ByVal meHight As Double, _
             ByVal meWidth As Double, _
             ByVal srcRange As Range)    '……(1)'
  numOfCombos_ = numOfCombos_ + 1    '……(2)'
  ReDim Preserve srcRange_(numOfCombos_ - 1)
  Set srcRange_(numOfCombos_ - 1) = srcRange
  ReDim Preserve cmbBox_(numOfCombos_ - 1)    '……(3)'
  Set cmbBox_(numOfCombos_ - 1) = _
      Controls.Add("Forms.ComboBox.1", "cmbBox" & numOfCombos_, True)    '……(4)'
  With cmbBox_(numOfCombos_ - 1)    '……(5)'
    .top = posTop    '……(6)'
    .left = posLeft
    .height = meHight
    .width = meWidth
    Dim i As Integer
    For i = 0 To srcRange_(numOfCombos_ - 1).Rows.Count - 1    '……(7)'
      .AddItem srcRange.Cells(i + 1, 1).Value
    Next
  End With
End Sub

まずは、宣言セクションの(*)からの３行

Private srcRange_() As Range
Private cmbBox_() As MSForms.ComboBox
Private numOfCombos_ As Integer

３つのPrivate変数を宣言。

srcRange_は、コンボボックスのデータソースになるセル範囲を入れておく変数。複数になることを想定して配列にしている。

cmbBox_()は、動的に生成したコンボボックスを格納しておく変数。これまた複数になることを想定して配列にしている。

numOfCombos_は生成されたコンボボックスの数を記録するための変数。

(1)では、コンボボックスを生成するためのcreateComboBoxメソッドを定義。

とりあえず５つの引数を受け取ってコンボボックスを作成することにする。

それぞれの引数の役割は、以下の通り。

• ・posTopはフォーム上のタテ位置。
• ・posLeftはフォーム上のヨコ位置。
• ・meHeightはコンボボックスの高さ。
• ・meWidthはコンボボックスの幅。
• ・srcRangeはデータソースになるセル範囲。

実際にはもっと細かく指定しないと使い物にならないけれど、今回はとりあえずの実験なのでこのぐらいで勘弁してほしい。

(2)の

numOfCombos_ = numOfCombos_ + 1

では、このメソッドが呼び出されるごとにnumOfCombos_をインクリメント。こうすることで、生成されたコンボボックスを番号で指定できるようにする。

(3)の

ReDim Preserve cmbBox_(numOfCombos_ - 1)

で、生成したコンボボックスを格納するための配列変数をReDimする。前に格納していたコンボボックスが消えないように、Preserveしている。

(4)の

Set cmbBox_(numOfCombos_ - 1) = _
      Controls.Add("Forms.ComboBox.1", "cmbBox" & numOfCombos_, True)

では、ControlsコレクションのAddメソッドを用いて、配列変数cmbBox_()に新たに生成したコンボボックスを格納。

Newできたら分かりやすいのになあ。

(5)からは、

With cmbBox_(numOfCombos_ - 1)

このように、「cmbBox_(numOfCombos_ - 1)」をWithで括ることによって、新たに追加したコンボボックスへの設定を行う。

ただし、(6)からの４行

.top = posTop
.left = posLeft
.height = meHight
.width = meWidth

なんかヘンだと思いませんか？

実は、インテリセンスが働かず、

このように入力候補にも出てこないのです。

んで、改行しても頭文字が小文字のまま。メチャクチャ不安になりますな。

あとは、(7)からの３行

For i = 0 To srcRange_(numOfCombos_ - 1).Rows.Count - 1
  .AddItem srcRange.Cells(i + 1, 1).Value
Next

AddItemメソッドでドロップダウンリストにsrcRangeからデータを追加している。

ホントは、Listプロパティを設定して複数列リストに対応しないといけないんだけれど、今回は実験ということで１列で勘弁してほしい。

実行

標準モジュールに次のコードを書いて実行する。

リスト２　標準モジュール

Public Sub exhibition()
  Dim frm As TestForm02    '……(1)'
  Set frm = New TestForm02
  With frm
    .createComboBox 10, 30, 20, 80, ActiveSheet.Range("B2:B7")    '……(2)'
    .createComboBox 10, 130, 20, 80, ActiveSheet.Range("C2:C7")
    .Show    '……(3)'
  End With
End Sub

まず、(1)からの２行

Dim frm As TestForm02
Set frm = New TestForm02

TestForm02型の変数frmにTestForm02のインスタンスを格納。

(2)からの２行は、WithでまとめているのでいづれもTestForm02のインスタンスに対する処理。

.createComboBox 10, 30, 20, 80, ActiveSheet.Range("B2:B7")
.createComboBox 10, 130, 20, 80, ActiveSheet.Range("C2:C7")

createComboBoxメソッドを、引数を変えて２回呼び出している。

で、(3)の

.Show

でフォームを表示しておしまい。

実行結果

このように２つのコンボボックスが設置されたフォームが表示され、

左側のコンボボックスにはＢ列のデータが、

右側のコンボボックスにはＣ列のデータが入っている。

おわりに

これだけではまるで使い道がないし、使い物になるコンボボックスにするためには設定すべきプロパティがメチャクチャたくさんあるので、普通にメソッドに引数を渡すような実行方法は現実的でないと思う。

たとえば、ワークシートにコンボボックスの細かい仕様を表す表を作成しておいて、そこから値を読み込んでプロパティを設定するというやり方になりそうだ。

あと、イベントを検知できなければ使い物にならないので、WithEventsキーワードの使い方についてもこれから研究していく必要がある。

けっこう面白いかも知れないなあ。

【参考】

akashi-keirin.hatenablog.com

差込印刷のデータソースにおけるVLOOKUP関数の使用――(2)

差込印刷のデータソースにおけるVLOOKUP関数

akashi-keirin.hatenablog.com

この続き。

問題は戻り値の「0」（ゼロ）

差込印刷のデータソースの表でVLOOKUP関数を使うと、検索値によって差し込みたいデータが決まっているようなときは非常に都合が良い。

ただ、前回も述べたように、空白を返したいときでも、戻り値は「0」（ゼロ）になってしまうため、差し込みフィールドに「0」が差し込まれてしまう。

前回は、「0」を表示させないためにフィールドコードでIF文を用いたが、改段落が残ってしまうため、非常にぶさいくな仕上がりになってしまう。

VLOOKUP関数の戻り値「0」を「""」に置き換える

ならば、と戻り値が「0」のときにそれを「""」（空白文字列）に置き換えることを考える。

理屈は簡単。IF関数でVLOOKUP関数の戻り値が「0」の場合に「""」にするようにすれば良い。

ただ、ただでさえ引数部分がクソ長ったらしくなるVLOOKUP関数をIF関数でネストするわけだから、ちょっとした下ごしらえは必要。

まず、表引きの元になる表に、

こんなふうに、「競輪場一覧」と名前を付けた。これでVLOOKUP関数の第２引数はぐっと簡単になる。

んで、差込データソースの表のＢ列以降には、たとえば

こんなふうに、

=IFERROR(
   IF(VLOOKUP($A2,競輪場一覧,COLUMN(Sheet1!B$1),FALSE)=0,
     "",
     VLOOKUP($A2,競輪場一覧,COLUMN(Sheet1!B$1),FALSE)
   ),
 ""
 )

あまりにも長すぎるのでインデントしてみたけど、大して可読性は上がらないな。

要するに、

VLOOKUP($A2,競輪場一覧,COLUMN(Sheet1!B$1),FALSE)

の戻り値が「0」だったら、""を表示せよ、と言っているだけなんだけれど。

ともかく、こんなふうにしておくと、

「0」が消えて空白セルになった。

んで、差込印刷の結果を見てみる。

おお、バッチリじゃん！

おわりに

特にVBAの出番もなく解決してしまったけれど、仮にIFERRORのネストを外したとしても結構めんどくさい数式記述が必要なのがイマイチ。もっとスッキリさせたいんだけれど。

追記

VLOOKUP関数で空白（""）を返す方法

･･･とかなんとか思っていたら、なんと、おなじみOffice TANAKAさんのコチラのページに、

VLOOKUP関数の結果が空欄だったとき、0ではなく空欄を返すようにするには、

=VLOOKUP(D2,A2:B5,2,FALSE)&""

と、末尾に「&""」をつけます。
「&」は文字列を結合する演算子で、空欄である「""」を結合することによって、0を空欄に変換できます。

ですってばよ！

くそう、

めちゃくちゃカンタンじゃねーかよ！

やっぱり、達人の皆さんはすげえなあ。

差込印刷のデータソースにおけるVLOOKUP関数の使用

差込印刷のデータソースにVLOOKUP関数を使うとちょっと困る

Wordの差込印刷は気が利く

たとえば、Excelで

こんな表を作っておいて、差込印刷のデータソースに指定しておく。

Wordの方では

こんなふうに差し込みフィールドを設定しておく。

んで、差し込んだ結果を見ると、

こんなふうに、データの存在しないところはちゃんとツメてくれる。改段落すらなかったことにしてくれる。

気が利くじゃないか、Word!!!!!!!!!

差し込みデータソースでVLOOKUP関数を使う

今度は、データソース用の表を

こんなふうにする。

たとえば、Ｂ列以降のセルに

=IFERROR(VLOOKUP($A2,Sheet2!$A$1:$H$4,COLUMN(Sheet1!B$1),FALSE),"")

こんな数式を入れておいて、Ａ列の値に応じてＢ列以降の値を返そうという算段。

VLOOKUP関数の返り値なので、空白だったところには「0」が返っている。

すると、差込印刷の結果は、

こんな悲しいものになる。なんてこった。

フィールド コードで対応する

対応策をggってみたところ、ヒットしたのが見出しの方法。

差し込みフィールドの場所を右クリックして、

「フィールド コードの表示/非表示」をクリック。

たとえばこのようにフィールド コードを書き換える。

「｛」、「｝」は、

直接入力するんじゃなくて、[Ctrl]＋[Ｆ９]

なので注意。あと、

[Ctrl]＋[Ｆ９]を押すときは、半角モードにしておく

のも忘れずに。私は初めてフィールド コードをいじくろうとしたとき、コレでしばらくハマりましたんでｗ

こうしておくと、差し込み結果は

こんなふうになる。

困ったことに、改段落をなかったことにはしてくれない。

さてどうするか。続きは次回！

コチラもどうぞ！

akashi-keirin.hatenablog.com

akashi-keirin.hatenablog.com