t-hom’s diary

主にVBAネタを扱っているブログ…とも言えなくなってきたこの頃。

節目のブースト効果について

さて、そろそろ世間の皆様もお仕事が始まる頃だろうか。

新年を迎え、今年こそは「〇〇」と意気込んでいる方も多いと思う。
これに対し先日、Twitterでは冷ややかな反応が「いいね」を集めていた。

普段から「〇〇」してない連中が新年にこぞって「〇〇」を誓う姿が滑稽だし、どうせ三日坊主だろうという反応である。

なるほど一理ある。というか、私もどちらかと言えば冷ややかに見守る側の人間だった。

しかし、日々の生活はあまりに日常的すぎて、自堕落な人間が何かを始めるには相当な気力が必要になる。
まぁ、当たり前っちゃ当たり前のことなんだけれど、今更本当の意味で理解したというか、その冷ややかなツイートを見て改めて「いや、ちがうんだよ」という気持ちが湧いてきたので、一応記事に残しておこうと思った次第である。

最近私は、節目の力を借りるというのは、とても良いことだと考えている。
節目のブースト効果で、それほど大きな気力を必要とせず、何か新しいことを始められる。
この現象を節目ブースターと呼ぼう。節目ブースターを使えば、怠惰と戦うことなくスタートダッシュを切れる。

私の場合、昨年12月から今年の1月にかけて、3つの節目がある。
ひとつは転職、もうひとつはその転職先の企業が迎える節目、そして今月中旬の自宅引っ越し。

きのこ3つ。圧倒的、節目ブースター!
これはもう、色々と頑張るしかないっしょ。

VBScriptとSAPIとタスクスケジューラで、一定時間ごとに音声で休憩を促す仕組みを構築

前回の記事で紹介した音声読み上げの仕組みをVBScriptに移植して、タスクに登録することで一定時間ごとに音声で休憩を促してくれる仕組みを作った。Windows 8.1以降で動作すると思われる。7は多分、音声合成エンジンが標準で入っていないのでダメ。

今回は英語メッセージを読み上げるサンプルを紹介する。これは単に自己満足なので日本語が良い方は前回記事を参考にボイスを切り替えると良い。

■前回の記事
thom.hateblo.jp

VBSの準備

以下のようなコードを準備して、適当な場所にSpeakMessage.vbsとして保存する。
保存場所はバッチ用なので普段触らない場所が良いと思う。私の場合はCドライブ直下にTaskというフォルダを作ってその中に入れた。

Call SpeakMessage

Sub SpeakMessage()
    With CreateObject("SAPI.SpVoice")
        Set .Voice = .GetVoices().Item(1)
        .Speak "Hey Thom! It's time to take a break. Stop using computer and take a rest while 5 minutes."
    End With
End Sub

フランクでフレンドリーな感じにしたかったのだけれど、英語として合ってるのかは自信ない。

Googleさんに和訳してもらうとこんな感じ。
f:id:t-hom:20180103163842p:plain

タスクの登録

まず、タスクスケジューラを起動する。
Windows 10の場合、1)スタート→2)Windows 管理ツール→3)タスクスケジューラと辿る。
f:id:t-hom:20180103164554p:plain

起動したら操作メニューからタスクの作成を実行。
f:id:t-hom:20180103164948p:plain

全般タブでは任意の名前を設定する。今回はInformBreakTimeとした。
f:id:t-hom:20180103165118p:plain

トリガータブでは新規ボタンをクリックし、出てきたウインドウで次の赤枠のとおり設定する。
f:id:t-hom:20180103165610p:plain
青枠の箇所は任意。1時間に1回なら、キリの良い時間に開始設定しておくと良い。

操作タブでは新規ボタンをクリックし、出てきたウインドウで操作がプログラムの開始になっていることを確認し、参照ボタンをクリックする。
f:id:t-hom:20180103165858p:plain

先ほど作成したSpeakMessage.vbsを選択し、次の良いにセットされたらOKで閉じる。
f:id:t-hom:20180103170011p:plain


これで設定は完了したのでタスクの作成ウインドウもOKで閉じる。

タスクスケジューラライブラリに表示されたらタスクスケジューラを閉じて作業完了。
f:id:t-hom:20180103170252p:plain

ちなみにタスクスケジューラライブラリから目的のタスクを右クリックすることで手動実行したり無効にしたり、削除したりできる。
手動で実行すると音声が終わってもタスクが終了しなかったので、右クリックして終了させる。
f:id:t-hom:20180103170521p:plain

その際に次のようなメッセージが出るが、OKで良い。
f:id:t-hom:20180103170541p:plain

これで1時間ごとに自動で休憩を促してくれるようになる。
なお、自動実行の場合は実行が終わると状態が準備完了に戻る。

おわりに

5分経過した後に「作業にもどってOK」の旨を通知するスクリプトを書いても良いなと思った。
やり方としては、ひとつのVBSの中で5分Waitさせても良いし、2つスクリプトを作ってタスクをもう一つ登録するのも良い。
あるいはスクリプトに引数を持たせて1つのスクリプト、2つのタスクで引数によってメッセージを切り替えるという手もある。

モニターの見過ぎや、座りっぱなしは健康に悪い。適宜休憩をとろう。

追記

後から気付いたけど、これ5分休憩よりも「5分間、部屋の掃除をしなさい」という指示に変えたほうが良さげ。
体力仕事の休憩は文字通り体を休めることだけれど、コンピューター作業の休憩は逆に体を動かすことなので。
綺麗な部屋と健康を得られるので一石二鳥。

Excel VBAで音声読み上げ

今回はExcel VBAでSAPIを使った音声読み上げを紹介する。
SAPIとはSpeech Application Programming Interfaceの略で、Windowsアプリケーションで音声認識や音声合成を使うためにマイクロソフトが開発したAPIである。
Windows 8.1 以降のOSには標準で音声合成エンジンが同梱されている。

※Windows 7の場合、SAPIの仕組み自体はありますが音声合成エンジンが別途調達しないといけないので今回のマクロはそのままでは動作しないと思われます。

作成したコードはこちら。

Sub Greeting()
    With CreateObject("SAPI.SpVoice")
        Set .Voice = .GetVoices.Item(0)
        .Speak "こんにちは"
    End With
End Sub

このマクロを実行すると、日本語で「こんにちは」と読み上げられる。
※読み上げ中は他の操作ができなくなるので注意。
ただWindowsにインストールされている音声合成エンジンに依存するため、環境によってうまくいかないこともあるかもしれない。

利用できる音声合成エンジンを調べる方法

利用できる音声合成エンジンを調べるには次のマクロを実行する。

Sub ShowVoiceList()
    With CreateObject("SAPI.SpVoice")
        For i = 0 To .GetVoices.Count - 1
            Debug.Print i & ":" & .GetVoices.Item(i).GetDescription
        Next
    End With
End Sub

私の環境(Win10Home 64bit)の場合、イミディエイトウインドウに次のように表示された。

0:Microsoft Haruka Desktop - Japanese
1:Microsoft Zira Desktop - English (United States)
2:Microsoft David Desktop - English (United States)

冒頭で紹介したGreetingマクロにSet .Voice = .GetVoices().Item(0)という一文があるが、このItemプロパティの0を1に変えると私の環境ではZiraという英語ボイスになる。ただ英語なので日本語には対応していない。

外国人ボイスで日本語を読み上げる方法

日本語ボイスがインストールされてない場合、ローマ字で「kon nichiwa」と入力すればカタコトで、「コンニチハ」と読み上げてくれる。「Konnichiwa」だと「ケネティワ」に聞こえたのでスペースを空けた。

Sub GreetingKatakoto()
    With CreateObject("SAPI.SpVoice")
        Set .Voice = .GetVoices.Item(1)
        .Speak "Kon nichiwa"
    End With
End Sub

参照設定で利用する場合

参照設定を利用する場合は、Microsoft Speech Object Libraryを参照する。
ただし、環境によっては下図のように同名の参照が2つ存在するので、実体の場所を確認し、sapi.dllとなっているものを選択する。
f:id:t-hom:20180103153150p:plain

もう片方はsapi_onecore.dllとなっていたが、こちらはVBAから使えなかった。

参照設定させると、冒頭のGreetingは次のようになる。

Sub GreetingOnReference()
    With New SpVoice
        Set .Voice = .GetVoices().Item(0)
        .Speak "こんにちは"
    End With
End Sub

あるいは変数を宣言しても良い。
以下は、型が分かるように逐一変数に入れた例。

Sub GreetingWithVariables()
    Dim greeter As SpVoice
    Set greeter = New SpVoice
    
    Dim speechVoice As ISpeechObjectToken
    Set speechVoice = greeter.GetVoices.Item(1)
    
    Set greeter.Voice = speechVoice
    greeter.Speak "Kon nichiwa"
End Sub

何がしたかったのか

パソコンの連続使用はとても目に悪い。仕事では会議に行ったり上司に呼ばれたりして適宜モニターの前を離れることもあるけど、自宅で作業に没頭してしまうとついつい何時間もモニターを見つめ続けることになる。
そこで、一定時間ごとに音声で知らせてくれるような仕組みを作ろうと思ったのがきっかけ。

とりあえず最初はExcelで作ったのでそのまま記事にしたけれど、オブジェクトの使い方さえ分かればVBSへの移植は簡単。あとはタスクスケジューラに登録して一時間ごとに音声で休憩を促す。この辺りは次回の記事で書こうと思う。

きっかけは最近購入した以下の書籍。

ヘルシープログラマ ―プログラミングを楽しく続けるための健康Hack

ヘルシープログラマ ―プログラミングを楽しく続けるための健康Hack

  • 作者:Joe Kutner
  • 発売日: 2015/07/23
  • メディア: 単行本(ソフトカバー)

その中に次の一節がある。

アメリカ労働安全衛生局によると、コンピュータを使う作業者が5分間の「ミニ休憩」を一日のうちに5回増やせば、痛みと眼精疲労が大きく減るのです。

なるほど。では1時間ごとに5分の休憩を取ろうと思ってこれを考えた。

ちなみにヘルシープログラマはわざわざエンジニアのために書かれた健康本である。「健康へのイテレーティブなアプローチ」などと、一般の方にはちょっと何言ってるか分からない用語が頻出し、ほとんど文字情報なので活字耐性のない非プログラマーは退屈するかもしれない。でも論理的に書かれていて、エンジニアには良い本だと思う。

2021/1/30 追記

以下のように音声を追加してみたところ、前述の方法では追加した音声が使用できないことが分かった。
f:id:t-hom:20210130182227p:plain

調べたところ、OneCoreという別の場所に分類されてるらしく、コードを変更することで対応できるようだ。

以下、参考サイト
qiita.com

以下、サイトを参考に作ってみたコード。JamesとZiraとHarukaがそれぞれ文を読み分ける。

Sub JamesZiraHarukaSpeaksByExcelVBA()
    Dim sapi As Object, tokenCategory As Object
    Set sapi = CreateObject("SAPI.SpVoice")
    Set tokenCategory = CreateObject("SAPI.SpObjectTokenCategory")
    tokenCategory.SetID "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Speech_OneCore\Voices", False
    
    Dim James As Object
    Dim Zira As Object
    Dim Haruka As Object
    Dim token As Object
    For Each token In tokenCategory.EnumerateTokens
        If token.GetAttribute("Name") = "Microsoft James" Then
            Set James = token
        End If
        If token.GetAttribute("Name") = "Microsoft Zira" Then
            Set Zira = token
        End If
        If token.GetAttribute("Name") = "Microsoft Haruka" Then
            Set Haruka = token
        End If
        If Not (James Is Nothing Or Zira Is Nothing Or Haruka Is Nothing) Then Exit For
    Next
    
    Set sapi.Voice = James
    sapi.Speak "From Wikipedia Poisson's Ratio"
    sapi.Speak "In materials science and solid mechanics, " _
                    & "Poisson's ratio is a measure of the Poisson effect, " _
                    & "the deformation of a material in directions perpendicular to the direction of loading. "
    
    Set sapi.Voice = Zira
    sapi.Speak "The value of Poisson's ratio is the negative of the ratio of transverse strain to axial strain."
    sapi.Speak "For small values of these changes, " _
                    & "is the amount of transversal elongation divided by the amount of axial compression."
    
    Set sapi.Voice = Haruka
    sapi.Speak "以上で解説を終わります。ありがとうございました。"
End Sub

以上

ひと足先にPythonでCOMを利用したExcel操作をやってみる

MicrosoftExcelPythonを搭載することを真剣に検討しているらしい。
www.itmedia.co.jp

まだ検討の段階なので、どんな実装になるかは明らかにされていないが、基本的にはVBAと同じくCOMの操作になるんじゃないかと思う。

今回はひと足先に、PythonでCOMを利用したExcel操作をやってみようと思う。

参考にしたサイトはこちら。
Python Win32 Extensions - MyMemoWiki

COMとは

COMとは「コンポーネント・オブジェクト・モデル」の略で、様々なプログラミング言語から呼び出すことができるソフトウェア部品の技術仕様として1997年にMicrosoftが発表したものである。
.NET登場以前はWindowsの標準的な技術であり、現在も数多くのソフトウェアがCOMに依存している。

COMではオブジェクトをメモリにどういう風に配置するか、自身が持つプロパティやメソッドを呼び出し元にどうやって伝えるかといった細々とした仕様が取り決められているので、COMの仕様に従った部品は様々な言語から利用することができる。

Excel VBAも、実はVBA言語でExcelのCOMオブジェクトを操作する行為であり、例えばRange("A1").Value = "Hello"という命令はVBAというよりも、ほぼCOMの操作に近い。

厳密にいえば、以下の特徴はCOMではなくVBAの仕様である。

  • イコールで代入する
  • オブジェクトのプロパティにはドットでアクセスする
  • 文字列はダブルクォーテーションで囲む
  • 大文字、小文字を区別しない

ただ最初の3つは多くの言語で採用されているので、Pythonで書いてもJavaで書いてもRubyで書いても、Range("A1").Value = "Hello"となる。そうでない言語もあるかもしれないが。

PythonでのCOM操作(準備編)

Pythonのインストールは多くのサイトで解説があるので本記事では省略する。
PythonでCOMを利用するためには、別途「Python Win32 Extensions」のインストールが必要である。

インストールするべきWin32 ExtensionsのバージョンはPythonのバージョンによって異なるため、まずはPythonのバージョンをチェック。
コマンドプロンプトを起動し、pythonと入力するとバージョンが表示される。
f:id:t-hom:20171224200547p:plain

そして以下リンクよりSourceForgeへアクセスし、
https://sourceforge.net/projects/pywin32/files/


pywin32のフォルダリンクを開く。
f:id:t-hom:20171224201057p:plain

するとビルドの一覧が表示される。ここは一番新しいもので良い。
f:id:t-hom:20171224201230p:plain

ここからちょっとややこしいけれど、使っているPCのCPUがAMD製かIntel製かによって変わる。
上半分のamd64と付いたものがAMD用、下半分がIntel用になっている。
f:id:t-hom:20171224202131p:plain

私の環境はIntel製CPUで、Pythonのバージョンが3.6.2なので、pywin32-221.win32-py3.6.exeをダウンロードした。

インストールは英語だけれど、「次へ、次へ、次へ、完了」と進めるだけなので特に問題ないと思う。

PythonでのCOM操作(実践編)

さて、では実際にExcelを操作してみよう。
先ほどバージョン確認のためにPythonを起動したが、これはexit()を入力して終了させて、再度pythonコマンドで起動しておく。
また、起動しているExcelがあれば終了させておいたほうが分かりやすい。

そして、入力待ちのプロンプト「>>>」が表示されたらimport win32com.clientと入力してEnter。

>>> import win32com.client

これは先ほどインストールしたPython Win32 Extentionsを読み込むための命令で、成功すれば単に次の入力プロンプト「>>>」が表示される。
他にズラズラと表示されてたらエラーなのでスペルミスがないか、インストールに成功しているか再確認する。

次に、変数xlAppにExcelを代入する。

>>> xlApp = win32com.client.Dispatch("Excel.Application")

ややこしい操作だけれど、VBScript のSet xlApp = CreateObject("Excel.Application")に相当する操作だと思っていだけると良い。
Pythonには変数宣言が存在しないので、単に変数名に値を代入するという操作になる。
また、VBAの場合はオブジェクトの代入にはSetを使うが、Pythonは数値や文字などと同じく単に代入するだけである。

さて、この段階でExcelがバックグラウンドで起動されているが、画面上はまだ表示されていない。
次に、Excelを表示させる。

>>> xlApp.Visible = -1

xlAppはExcel VBAのApplicationと同じように扱える。VBAの場合はApplication.Visible = Trueと書くが、VBAではTrueの値が-1なのに対し、PythonではTrueの値が1なので、ここでは-1を指定している。

ただVBAは0をFalse、0以外をTrueと判定するので、xlApp.Visible = Trueと書いても動作する。以降は分かりやすいようにPythonのTrue、Falseを使って書く。

さて、ここまで来たら、基本的なCOM操作はVBAと変わらない
ワークブックを追加してシート名をSampleに変え、A1セルにHelloと入力してクローズする処理をやってみる。

>>> wb = xlApp.Workbooks.Add()
>>> sh = wb.Sheets(1)
>>> sh.Name = "Sample"
>>> sh.Range("A1").Value = "Hello"
>>> xlApp.DisplayAlerts = False
>>> wb.Close()
>>> xlApp.DisplayAlerts = True
>>> xlApp.Quit()

コマンドを入力してEnterするたびに、処理が実行されるのが分かる。
ちなみに上記の処理をVBAで書くとこうなる。

    Set xlApp = Excel.Application
    Set wb = xlApp.Workbooks.Add
    Set sh = wb.Sheets(1)
    sh.Name = "Sample"
    sh.Range("A1").Value = "Hello"
    xlApp.DisplayAlerts = False
    wb.Close
    xlApp.DisplayAlerts = True
    xlApp.Quit

VBAPythonの違いを見てみると、

  • オブジェクトの代入にSetをつけるかどうか
  • 引数のないメソッド呼び出しに()を付けるかどうか

という2点を除いて、あまり変わらない。

つまりCOMである以上、オブジェクトの操作感はそれほど変わらないということになる。
ではPythonだと何が嬉しいのかというと、豊富なライブラリ群と洗練された言語仕様である。

Pythonの機能を使ってマクロを作る

折角なのでPythonのライブラリを使ってExcelマクロを作ってみよう。

サンプルなのでVBAでも簡単にできるような内容にしておく。

>>> import win32com.client
>>> import datetime
>>> xlApp = win32com.client.Dispatch("Excel.Application")
>>> xlApp.Visible = True
>>> wb = xlApp.Workbooks.Add()
>>> ws = wb.Sheets(1)
>>> now = datetime.datetime.now()
>>> ws.Range("A1").Value = now.hour

これは最初にPythonのdatetimeライブラリを読み込んでおき、変数nowに現在日時を入れて「〇時」だけを取り出すマクロ。
Pythonのdatetime型はオブジェクトなので、hourプロパティで時刻を取り出すことができる。
ブログ執筆時点では夜9時なので、A1セルには21が挿入される。

VBAならNow()関数とHour()関数を組み合わせるところだが、こちらはVBA専用の関数なのでPythonからは利用できない。
またCollectionもVBAライブラリのクラスなのでPythonからは利用できない。
VBA自体もおそらくCOMなので、PythonからVBA関数を利用する方法はあるかもしれない。

更に、配列などのデータ型や、IfやForなどの構文もVBAとは異なる。
共通しているのはあくまでCOMの操作部分だけである。

for文を例にPythonの特徴を紹介

実はPythonVBAのようなFor文は無く、VBAでいうところのFor Eachが標準のfor文にあたる。
たとえば1から10まで出力させたい場合、VBAでは次のように書く。

For i = 1 to 10
    Debug.Print i
Next

Pythonではこうなる。

>>> for i in range(1, 11):
...     print(i)
...

ここでrangeはpythonの関数なのでExcelのRangeとは関係ないことに注意。
1~11を指定するとひとつ少ない1~10が作られるという、VBA使いには馴染みのない仕様である。

この...は>>>と同じく前行から続いているという意味のプロンプトなので自分で入力する必要はない。
for文の最後は必ずコロンを入力して改行する。そしてTabキーでインデントし、print(i)と入力してEnter。
これで終わりなら、プロンプト「...」でそのままEnterを入力すると1~10まで出力される。

また、VBAではブロックを開始と終了のステートメントで表すのに対し、Pythonではインデントで表す。
コードの見た目がそのまま文法になってしまうので自由にインデントすることはできない。
これにはスタイルの違いによる読みにくさが発生しないというメリットがある。

さて、では最後のサンプルとしてPythonのforでVBAのFor Eachと同じようにセルに対して使ってみよう。
次のコードを実行するとA1からA5にそれぞれHelloと入る。

>>> for r in ws.Range("A1:A5"):
...     r.Value = "Hello"
...

これでCOMの操作は同じであるが、標準関数や文法が異なるということがお分かりいただけたかと思う。

終わりに

ExcelPythonが標準搭載される意味はとても大きいと思う。
言語を選択できるようになれば、マクロとVBAの違いなども説明しやすくなる。また、何がExcelのCOM操作で、何が言語機能なのかがよりハッキリするので、Excel VBAの構成もよりクリアに認識できるようになると思う。

現在COM以外の方法でPythonからExcelを操作するライブラリなどもあるけれど、個人的には標準搭載するならCOM方式が良いのではないかと思う。

MicrosoftはCOMの後継にあたる.NETを推進しているが、.NET言語であるVB.NetC#を外してあえてPythonの搭載を検討するあたり、Excelの.NET対応は考えていないのではないかと思う。

COMならPythonのスッキリした文法と豊富なライブラリの恩恵を受けつつ、従来のVBAユーザーもPythonに移行しやすい。

今のところPythonは完全に動的型付け言語なので、入力補完などのIDE機能は期待できない。
手入力も面倒なので、この辺りはMicrosoftが何か考えてくれるといいなと思う。

さて、今回はすべてコマンドラインからの入力だったが、もちろんファイルに書いて実行することもできる。
興味があれば書籍や他のWebサイト等で調べてみると良いと思う。

本格的にPythonを学習される場合は以下の書籍がオススメ。

Pythonスタートブック

Pythonスタートブック

レビュー記事も書いているのでよろしく。
thom.hateblo.jp

Access VBAでフォームのコントロールイベント共通化

前回紹介したExcel VBAのユーザーフォームに動的メニューを追加する方法を紹介した。
thom.hateblo.jp

ただ、実は作りたかったのはAccessで、連票フォームのフッター領域にそれを配置したかったのだ。
f:id:t-hom:20171216122925p:plain

慣れないAccessと格闘する前にまずExcelフォームでプロトタイプを作ろうと思い立ったのが前回の記事。

Accessフォームで発生した問題

さて、Accessに移植するにあたり、ひとつハマったことがある。
すごく単純なことだけど、コントロールイベントをクラスで検知しようとした際に、うまく動かなかったのだ。
原因はボタンのクリック時イベントに、[イベントプロシージャ]を選択していなかったこと。

今回はこれについて順を追って説明する。

まず以下のようなフォームを作成した。
f:id:t-hom:20171216123618p:plain

それからVBEでクラスモジュールを挿入し、オブジェクト名をButtonWrapperとした。
コードは以下のとおり。

Public WithEvents btn As CommandButton

Private Sub btn_Click()
    MsgBox btn.Caption & "がクリックされました。"
End Sub


フォーム本体のコードは次の通り。

Private Buttons As Collection
Private Sub Form_Load()
    Set Buttons = New Collection
    For i = 0 To 4
        Dim b As ButtonWrapper
        Set b = New ButtonWrapper
        Set b.btn = Me.Controls("コマンド" & i)
        Buttons.Add b
    Next
End Sub

こうすると、コマンド0からコマンド4までの5つのボタンがButtonWrapperオブジェクトに包まれてCollection(Buttons)に格納される。
ButtonWrapper内ではボタン用の変数btnがWithEventsで宣言されているので、ボタンごとにイベントを書かなくてもこれでイベントを検知できる。

これだけで動くと思っていた。
実際、Excel VBAならこれだけで動く。

ところがフォームを起動してボタンを押してもうんともすんとも言わない。

解決策

調べた結果、ボタンのプロパティでクリック時イベントが空だと、いくらイベント検知のコードがあっても動かないらしい。
f:id:t-hom:20171216124457p:plain

ということで全ボタンを選択し、クリック時プロパティのプルダウンからイベントプロシージャを選択。
f:id:t-hom:20171216124749p:plain

これで、無事にイベントを検知できるようになった。

仕様の推察

Excelの場合はボタンをクリックした際のイベントはVBAで書くと決まっているのでイベントを検知したら即、対応するコードが実行される。
Accessでは事情が異なり、クリックイベント=VBAとは限らない。

試しにボタンを配置した後、デザインモードでクリックしてイベントのビルドを選択してみる。
f:id:t-hom:20171216130354p:plain

すると、ビルダーの選択画面が出てきて、コード(VBA)以外にも、式・マクロといったAccess機能でイベントを作成できることがわかる。
f:id:t-hom:20171216130738p:plain

クリック時プロパティに明示的に[イベントプロシージャ]を設定しておくと、Accessにコードを実行するということが伝わり、対応するコードが実行される。

普通にイベントをビルドした場合は問題ないが、今回のようにコントロールイベントを共通化する際は明示的にイベントのビルドを行わないので、この設定が必要である。

VBA クラスモジュールを使ってフォームに動的なメニューを作る

今回作成するのはボタンを動的に切り替えられるメニューである。

これだけでは意味が分からないと思うので動作サンプルを紹介する。
f:id:t-hom:20171209061338g:plain

通常は1つのボタンに1つの処理なので、5つボタンがあれば5つしか処理は書けないが、このメニューは▲と▼で動的にボタンを切り替えることができる。

作り方の紹介

必要なものは、

  • クラスモジュール「SelectButton」
  • クラスモジュール「PagedButtons」
  • フォームモジュール「(任意のオブジェクト名)」

SelectButtonの作り方

クラスモジュールを挿入し、オブジェクト名を「SelectButton」に変更する。
それから以下のコードを張り付け。

Option Explicit
Public WithEvents btn As MSForms.CommandButton
Public Parent As PagedButtons
Private Sub btn_Click()
    Parent.callBack btn.Caption
End Sub

Public Property Let Enabled(e As Boolean)
    btn.Enabled = e
End Property

Public Property Let Caption(x As String)
    btn.Caption = x
End Property

Public Property Get Self() As Object
    Set Self = Me
End Property

Public Sub ReleaseObject()
    Set btn = Nothing
    Set Parent = Nothing
End Sub

PagedButtonsの作り方

クラスモジュールを挿入し、オブジェクト名を「PagedButtons」に変更する。
※複数形のsを見落とさずに。
それから以下のコードを張り付け。

Option Explicit
Private WithEvents previousButton As MSForms.CommandButton
Private WithEvents nextButton As MSForms.CommandButton
Private pageNumber As Long
Private selectButtons As Collection
Private menuItems As Collection
Public Event Selected(x As String)

Sub callBack(x As String)
    RaiseEvent Selected(x)
End Sub

Sub Init(previous_button As MSForms.CommandButton, _
    next_button As MSForms.CommandButton, _
    ParamArray select_buttons())
    
    Set previousButton = previous_button
    Set nextButton = next_button
    
    Set selectButtons = New Collection
    Dim b
    For Each b In select_buttons
        With New SelectButton
            Set .Parent = Me
            Set .btn = b
            selectButtons.Add .Self
        End With
    Next
    
    Set menuItems = New Collection
    pageNumber = 1
End Sub

Sub addMenuItem(menu_caption As String)
    menuItems.Add menu_caption
End Sub

Sub DrawCaptions()
    previousButton.Enabled = pageNumber <> 1
    nextButton.Enabled = pageNumber < maxPage

    Dim itemCursor: itemCursor = selectButtons.Count * pageNumber - selectButtons.Count
    Dim i As Long
    For i = 1 To selectButtons.Count
        If itemCursor + i <= menuItems.Count Then
            selectButtons(i).Enabled = True
            selectButtons(i).Caption = menuItems(itemCursor + i)
        Else
            selectButtons(i).Enabled = False
            selectButtons(i).Caption = "-"
        End If
    Next
End Sub

Private Property Get maxPage() As Long
    maxPage = roundUp(menuItems.Count / selectButtons.Count)
End Property

Private Function roundUp(x As Double) As Long
    roundUp = Int(x + 0.999)
End Function

Private Sub nextButton_Click()
    pageNumber = pageNumber + 1
    DrawCaptions
End Sub

Private Sub nextButton_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call nextButton_Click
    If pageNumber >= maxPage - 1 Then
        Cancel = True
    End If
End Sub

Private Sub previousButton_Click()
    pageNumber = pageNumber - 1
    DrawCaptions
End Sub

Private Sub previousButton_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call previousButton_Click
    If pageNumber <= 2 Then
        Cancel = True
    End If
End Sub

Public Sub ReleaseObject()
    Dim b As SelectButton
    For Each b In selectButtons
        b.ReleaseObject
    Next
    Set menuItems = Nothing
    Set selectButtons = Nothing
End Sub

ユーザーフォームの作り方

ユーザーフォームを挿入し、オブジェクト名を以下のように変更する。
f:id:t-hom:20171209062344p:plain

btn1~btn5はCaptionと同じくオブジェクト名もbtn1~btn5にしておく。

そしてフォームのコードに以下を張り付ける。

Private WithEvents menu As PagedButtons

Private Sub menu_Selected(x As String)
    Me.Label1.Caption = x & "が選択されました。"
End Sub

Private Sub UserForm_Initialize()
    Me.Label1 = vbNullString
    Set menu = New PagedButtons
    
    menu.Init Me.btnPrevious, Me.btnNext, _
        Me.btn1, Me.btn2, Me.btn3, Me.btn4, Me.btn5
    
    Dim i As Long
    For i = Asc("A") To Asc("Z")
        menu.addMenuItem "項目" & Chr(i)
    Next
    menu.DrawCaptions
End Sub

Private Sub UserForm_Terminate()
    menu.ReleaseObject
    Unload Me
End Sub

これで完成。

このテクニックのポイント

このテクニックのポイントは、メニューボタンが押された際に発生するイベントがmenu_Selectedに集約される点だ。

Private Sub menu_Selected(x As String)
    Me.Label1.Caption = x & "が選択されました。"
End Sub

それぞれのボタンがバラバラに機能するのではなく、あたかもひとつのPagedButtonsというコントロールパーツであるかのように扱うことができる。

↓つまりこういう形のひとつのコントロールパーツとして扱うことができるということ。
f:id:t-hom:20171209063932p:plain

また、ボタン数の増減がきわめて簡単に行えることもポイントのひとつ。
試しにボタンをひとつ増やしてみた。
f:id:t-hom:20171209064527p:plain

コードの変更箇所はたった1箇所。
ユーザーフォームのUserForm_Initializeメソッドのmenu.Initに引き渡すボタンを一つ増やすだけで済む。
f:id:t-hom:20171209065211p:plain

ボタンを減らした場合も同様に、menu.Initに引き渡すボタンを減らすだけ。

今回は紹介しないが、動的なコントロールの生成と、APIによるフォームのサイズ変更を組み合わせると、フォームサイズの変化に合わせて表示ボタン数が変わる柔軟なメニューを作成することもできる。

仕組みの解説

さて、どういうことなのか説明しよう。
今回はクラスモジュール、コントロールイベントの共通化、自作イベントなどのテクニックを利用している。

まずPagedButtonsオブジェクトの初期状態はこんな感じの構成。
f:id:t-hom:20171209072843p:plain

PagedButtonsオブジェクトにボタンがひとつ渡されると、SelectButtonオブジェクトを生成し、そこにボタンを保持させて自身が持つSelectButtonsCollectionに格納する。
また、このときに自身(PagedButtonsオブジェクト)をSelectButtonオブジェクトに保持させる。
f:id:t-hom:20171209073114p:plain

ここで循環参照が発生してしまうが、イベントのコールバック処理で必要になるので仕方がない。
オブジェクトにReleaseObjectプロシージャを作ってあるのはそのためだ。
※SelectButtonオブジェクトからPagedButtonsオブジェクトへの参照をオレンジ線にしたのは、後の図で青だと見づらくなった為で、特別な意味はない。

PagedButtonsオブジェクトにボタンやメニュー項目を引き渡していくと、最終的なオブジェクトの関係図はこうなる。
f:id:t-hom:20171209073531p:plain

※実際にはボタンはInitプロシージャで一気に引き渡されますが、最初の図は1つにしておかないとややこしかったので説明の都合上、引き渡していくという表現にしています。

ページ切り替えのボタンまで図に含めると複雑すぎるので割愛したが、ページ切り替えを行うとmenuItemsコレクションから項目が取得され、それぞれのSelectButtonオブジェクトに格納される。

ユーザーがボタンをクリックした際のプロシージャ呼び出しをシーケンス図で書くとこんな感じ。
f:id:t-hom:20171209075244p:plain

callbackとSelectedでそれぞれボタンのCaptionが引き渡されるので、ユーザーフォーム側でどのボタンがクリックされたのか検知できる。

利用しているテクニックについての参考記事

thom.hateblo.jp
thom.hateblo.jp
thom.hateblo.jp
thom.hateblo.jp

循環参照についての参考記事

thom.hateblo.jp
thom.hateblo.jp

今後の展望

動的なコントロールの生成を組み合わせると柔軟性が高まる。以下の記事で動的にラベルを生成させているので紹介。
thom.hateblo.jp

たとえば上記の記事ではSet L = Me.Controls.Add("Forms.Label.1")としているが、Set btn = Me.Controls.Add("Forms.CommandButton.1")とすれば、新しいボタンが生成されて変数btnに格納される。

あと今回はPagedButtonsのSelectedイベントでキャプションを返しているが、addMenuItemメソッドをSub addMenuItem(menu_caption As String, data As Variant)に改造して押された項目に対応するdataを返すようにすれば更に柔軟性が高まる。たとえば押したボタンに応じたオブジェクトが返ってくると、そこから色々操作できて面白い。

ただし、今後の展望に書いた案については、きっとこの記事に興味がある皆さんが素晴らしい実装を作ってくれるので私はこれ以上作らない。面倒だし。。

VBA フォームのボタンの反応が遅い理由と対策

今回はVBAでユーザーフォームに配置したボタンの反応が遅い理由とその対策について紹介する。
検証のため、以下のようなカウンターフォームを作った。
f:id:t-hom:20171207210933g:plain

作成方法

フォームに配置した各オブジェクトは以下のように名前を変更した。
f:id:t-hom:20171207210921p:plain

コードは以下のとおり。

Private Sub cmdCountUp_Click()
    Me.lblCounter.Caption = CLng(Me.lblCounter.Caption) + 1
End Sub

Private Sub cmdReset_Click()
    Me.lblCounter.Caption = 0
End Sub

課題

ぽちっぽちっと丁寧に押していく分には問題ないのだが、連続して速くクリックしたときに反応が悪い。
↓9クリックしてるのに5しかカウントされてない。
f:id:t-hom:20171207211316g:plain

この事象、単にVBAのフォームが遅いためと思い込んでいる方もいるかもしれないが、原因は別のところにある。
試しにCountUpボタンにフォーカスが当たっている状態でスペースキーを連打するとちゃんと連打スピードについてくるのだ。つまりキーでボタンを押した場合は問題ないのに、マウスでクリックした場合は遅いということになる。

原因

原因は、コマンドボタンがダブルクリックイベントを拾っているため。
連続で速くクリックすると、次のように判定される。

  1. クリック
  2. ダブルクリック
  3. クリック
  4. ダブルクリック
  5. クリック
  6. ダブルクリック

つまり、クリック間隔が短いと、偶数回目のクリックがダブルクリック扱いになってしまうため、クリックイベントとしては半分しか判定されないのだ。

対策

この対策は簡単で、単にダブルクリックイベントをキャッチアップしてシングルクリックイベントのプロシージャを呼んでやれば良い。

Private Sub cmdCountUp_Click()
    Me.lblCounter.Caption = CLng(Me.lblCounter.Caption) + 1
End Sub

Private Sub cmdCountUp_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call cmdCountUp_Click
End Sub

Private Sub cmdReset_Click()
    Me.lblCounter.Caption = 0
End Sub

この対策を施した結果がこちら。
f:id:t-hom:20171207212052g:plain

ちゃんとクリックした分カウントアップされている。

別の問題

前述の対策は、とても良さそうに思える。
ただし、コマンドボタンの無効化と組み合わせると、ボタンが陥没して戻ってこないという別の問題が多発する。

試しに数値が10に達したらボタンを無効化するようコードを書き換えてみた。

Private Sub cmdCountUp_Click()
    Me.lblCounter.Caption = CLng(Me.lblCounter.Caption) + 1
    If CLng(Me.lblCounter.Caption) >= 10 Then
        Me.cmdCountUp.Enabled = False
    End If
End Sub

Private Sub cmdCountUp_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call cmdCountUp_Click
End Sub

Private Sub cmdReset_Click()
    Me.lblCounter.Caption = 0
    Me.cmdCountUp.Enabled = True
End Sub

すると、このようにボタンが陥没するようになった。
f:id:t-hom:20171207212527g:plain

無効化を解除してもボタンは凹んだままで、クリックすると戻る。
ボタンの陥没は、ダブルクリックイベント時にボタンを無効化すると発生するようで、シングルクリック時は発生しない。

以下は検証の結果。

事象が発生するパターン

  1. クリック
  2. ダブルクリック
  3. クリック
  4. ダブルクリック
  5. クリック
  6. ダブルクリック
  7. クリック
  8. ダブルクリック
  9. クリック
  10. ダブルクリック ←ここで無効化されるので陥没する

事象が発生しないパターン1

  1. クリック
  2. ダブルクリック
  3. クリック
  4. ダブルクリック
  5. クリック
  6. ダブルクリック
  7. クリック
  8. ダブルクリック
  9. クリックし、次がダブルクリックにならないようしばらく時間を置く。
  10. クリック ←ここで無効化されるので陥没しない

事象が発生しないパターン2

  1. クリックし、次がダブルクリックにならないようしばらく時間を置く。
  2. クリック
  3. ダブルクリック
  4. クリック
  5. ダブルクリック
  6. クリック
  7. ダブルクリック
  8. クリック
  9. ダブルクリック
  10. クリック ←ここで無効化されるので陥没しない

ボタン陥没の回避方法(没案)

この事象はフォームのRepaintをしてみたり、DoEventsを挟んでみたりしたけれど改善されなかった。
ということで根本的な解決策は見つかっていない。(あるいは存在しない)
ひょっとするとWinAPIなどで何とかする方法はあるのかもしれないが、少なくともVBA単体では見つからなかった。

今のところ、ボタンの無効化を諦めるか、最後がダブルクリックにならないように回避コードを書くしかなさそうだ。

回避コードとしては以下のように、無効化の一歩手前でダブルクリックイベントからのシングルクリックイベント呼び出しをやめること。

※以下は私が考えた手、古い回避方法です。より良い方法が見つかったので、後述のボタン陥没の回避方法(改)をご覧ください。

Private Sub cmdCountUp_Click()
    Me.lblCounter.Caption = CLng(Me.lblCounter.Caption) + 1
    If CLng(Me.lblCounter.Caption) >= 10 Then
        Me.cmdCountUp.Enabled = False
    End If
End Sub

Private Sub cmdCountUp_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    If CLng(Me.lblCounter.Caption) < 9 Then
        Call cmdCountUp_Click
    End If
End Sub

Private Sub cmdReset_Click()
    Me.lblCounter.Caption = 0
    Me.cmdCountUp.Enabled = True
End Sub

ただ軽快にカウントアップされて最後だけ1回「スカ」が入るので、イマイチだな。
↓9になるとダブルクリックイベントを無視するので最後だけボタンを2回クリックしている。
f:id:t-hom:20171207214833g:plain

ボタン陥没の回避方法(改)

imihitoさんにTwitterで回避方法を教えていただきました。ありがとうございます!

ということで、早速試してみた。

Private Sub cmdCountUp_Click()
    Me.lblCounter.Caption = CLng(Me.lblCounter.Caption) + 1
    If CLng(Me.lblCounter.Caption) >= 10 Then
        Me.cmdCountUp.Enabled = False
    End If
End Sub

Private Sub cmdCountUp_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call cmdCountUp_Click
    Cancel.Value = (CLng(Me.lblCounter.Caption) >= 9)
End Sub

Private Sub cmdReset_Click()
    Me.lblCounter.Caption = 0
    Me.cmdCountUp.Enabled = True
End Sub

ふむふむ、これで意図したとおりに動作している。

あれ、ちょっとまてよ。
ということは、ダブルクリックイベント自体はキャンセルしても、Call cmdCountUp_Clickで呼び出しは成功している?

であれば、単にCancel = Trueで良さげ。

ボタン陥没の回避方法(最終案)→没案

ということで最終的に完成したコードがこちら。

…と思ったけれど、無条件でキャンセルすると環境によってはボタンクリックした際の描画がおかしいらしい。
Office2016 64ビット版でカウントアップはされるがボタンクリック動作が遅れて見えるとのこと。
ひょっとすると、マシンスピードが速すぎるとクリックイベントでの描画が完了する前にダブルクリックイベントのキャンセルまで実行されてしまって描画が発生しないのかもしれない。

当方の環境で描画がおかしくなることはなかったが、以下の案は没案とし、推奨は「ボタン陥没の回避方法(改)」で紹介した条件付きCancelとしたい。

Private Sub cmdCountUp_Click()
    Me.lblCounter.Caption = CLng(Me.lblCounter.Caption) + 1
    If CLng(Me.lblCounter.Caption) >= 10 Then
        Me.cmdCountUp.Enabled = False
    End If
End Sub

Private Sub cmdCountUp_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call cmdCountUp_Click
    Cancel = True    '←無条件キャンセル。良いと思ったけれど環境依存の可能性が報告されたため没。
End Sub

Private Sub cmdReset_Click()
    Me.lblCounter.Caption = 0
    Me.cmdCountUp.Enabled = True
End Sub

あとがき(2017/12/9に執筆)

さて、今回の記事でボタン単品を連打する必要性に疑問を持たれた方もいると思うけれど、私が実際に作りたかったのはこちら↓
f:id:t-hom:20171209061338g:plain

ページめくり処理でもっさりしてストレスになったので今回記事にした。

今回のテクニック+諸々を使って、実際に作成したのでクラスモジュール上級者は、こちらも併せてどうぞ。
thom.hateblo.jp

当ブログは、amazon.co.jpを宣伝しリンクすることによってサイトが紹介料を獲得できる手段を提供することを目的に設定されたアフィリエイト宣伝プログラムである、 Amazonアソシエイト・プログラムの参加者です。