t-hom’s diary

主にVBAネタを扱っているブログです。

Pythonでルーチン読み上げツールを作ってみた

最近Pythonをかじりだした理由として、Rapsberry Piで使う目的で日常ルーチンを読み上げてくれるツールを作ったことがきっかけ。

※読み上げといってもテキスト合成ではなくて、単にwavファイルに入れておいた音声を再生するだけです。
 タイトルでがっかりさせちゃってたらすみません。

イメージとしてはこんな感じで起動してきて、再生ボタンをタップするたびに次のタスクを読み上げてくれるルーチンツール。
f:id:t-hom:20190916194425p:plain

掃除って単純なようで段取りを間違うと面倒なことになる。
そもそも普段から完璧に綺麗なら何も問題ないんだけど、物が散らかり始めると、Aを掃除中にBが気になり、Bに手を付けたら今度またAが気になりという風にデッドロックがかかる。

ので、ルーチンを設計して、それに命じられるままに掃除しようと。
コンピュータに使われる私。

まずはPythonをまじめに学習する前の私が書いたコード。思考錯誤して、なんとか動いたけど、謙遜抜きでまぁひどいコードである。
よく分からないままコピペした部分も少なからずあるので。

import os
import sys
import tkinter
import playsound
from tkinter import *
from tkinter import ttk
import tkinter.font as font

base = os.path.dirname(os.path.abspath(__file__))

def play(filenumber):
    global var
    txt = open(base + "/wav/CleanupRoutine-" + str(filenumber) + ".txt", 'r', encoding='utf-8')
    var.set(txt.read())
    root.update()
    txt.close

    filename=base + "/wav/CleanupRoutine-" + str(filenumber) + ".wav"
    playsound.playAudio(filename)

root = tkinter.Tk()
root.title("Tkinter test")
root.attributes("-fullscreen", True)
#root.geometry("800x480")

frame = tkinter.Frame(root)
frame.pack(fill="x")
button = tkinter.Button(frame, text="Quit",bg="#00a4e4",fg="#ffffff", width=5, command=root.quit)
button.pack(side="right")

n = 0
def button2_clicked(event):
    canvas.itemconfig(imagearea, image = icon2)
    root.update()
    global n
    play(n)
    n = n + 1
    if n > 14 :
        n = 0

    canvas.itemconfig(imagearea, image = icon1)
    root.update()

icon1 = PhotoImage(file=base + '/next.png')
icon2 = PhotoImage(file=base + '/next_disabled.png')

my_font = font.Font(root,family="fonts-vlgothic",size=20,weight="bold")
var = tkinter.StringVar()
lbl = tkinter.Label(root, textvariable=var, height=5, font=my_font)
lbl.pack()

canvas = tkinter.Canvas(root, width=128, height=128)
imagearea = canvas.create_image(0, 0, image=icon1, anchor=tkinter.NW)
canvas.bind("<Button-1>", button2_clicked)
canvas.pack()


root.mainloop()

色々インポートしてるけど、このうちplaysoundは私が別ファイルに書いたサウンドファイル再生用のモジュールで、それ以外は標準ライブラリ的なもの。(用語もまだあまり分かってない。)

こちらが、「やさしいPython」の「クラス」の学習まで終わってから修正したコード。

import tkinter as tk
import tkinter.font as font
import os
import playsound

class Application(tk.Frame):
    def __init__(self, master=None):
        super().__init__(master)
        self.master = master
        self.pack()
        self.load_resources()
        self.create_widgets()
        self.n = 0

    def load_resources(self):
        self.base = os.path.dirname(os.path.abspath(__file__))
        self.icon1 = tk.PhotoImage(file=self.base + '/next.png')
        self.icon2 = tk.PhotoImage(file=self.base + '/next_disabled.png')

    def create_widgets(self):
        #Root Setting
        self.master.title("Cleanup Routine")
        #self.master.attributes("-fullscreen", True)
        self.master.geometry("800x480")

        #Generate Parts
        frame1 = tk.Frame(master = self.master)

        quit_button = tk.Button(
            master = frame1,
            command = self.master.destroy,
            width = 5,
            text = "Quit",
            bg = "#00a4e4",
            fg = "#ffffff")

        next_button = tk.Canvas(
            master = self.master,
            width = 128,
            height = 128)
        self.imagearea = next_button.create_image(
                0, 0, image=self.icon1, anchor=tk.NW)
        next_button.bind("<Button-1>", self.next_clicked)

        self.var = tk.StringVar()
        my_font = font.Font(root,family="Migu 1M",size=20,weight="normal")
        lbl = tk.Label(root, textvariable=self.var, height=5, font=my_font)
        #Layout
        frame1.pack(fill="x")
        quit_button.pack(side="right")
        lbl.pack()
        next_button.pack()

        #Attributation
        self.frame1 = frame1
        self.quit_button = quit_button
        self.next_button = next_button
        self.lbl = lbl

    def play(self, filenumber):
        txt = open(self.base + "/wav/CleanupRoutine-" + str(filenumber) + ".txt", 'r', encoding='utf-8')
        self.var.set(txt.read())
        root.update()
        txt.close
    
        filename=self.base + "/wav/CleanupRoutine-" + str(filenumber) + ".wav"
        playsound.playAudio(filename)

    def next_clicked(self, event):
        self.next_button.itemconfig(self.imagearea, image = self.icon2)
        self.master.update()
        n = self.n
        self.play(n)
        n = n + 1
        if n > 14:
            n = 0
        self.n = n
        self.next_button.itemconfig(self.imagearea, image = self.icon1)
        self.master.update()


root = tk.Tk()
app = Application(master=root)
app.mainloop()

学習によって理解度も進んだので、最初のコードより幾分マシに見える。
インポート文の仕組みも分かったので余計なものをインポートするのもやめられた。

GUIは、Tkinterのサンプルコードをベースに必要なGuiパーツを肉付けしていくというやり方で作った。
実は最初のコードを書く段階ではTkinterのサンプルでクラスが使われているのでよく理解できず、クラスを使ってないサンプルを探し回って使ったんだけど、きちんと学習した後はクラスを使った方が合理的だと分かって書き直した。

ただ今度はクラスの肥大化とサウンド再生とかテキスト読み込み・出力とかがアプリケーションクラスにごちゃっと入ってるので、それはそれでメンテナンス性悪いのではという感じ。

selfの使い方も分かったけど、なんでもselfつけてとりあえずインスタンスの属性に放り込んでおけばいいや的な使い方をしてるので、「合ってるのかこの使い方?」という疑問がある。

次の課題はModel View Controllerの分離。
qiita.com

プログラミング言語はひとつマスターすれば他もできる?

プログラミングでは、ひとつの言語をマスターすれば、どんな言語でも使えると言われている。
この言説には賛否あるけど、ある意味正しくて、ある意味間違いだと思う。

より正確に言えば、新しく学ぶ言語と既にマスターしている言語に共通する概念についてはスムーズに移行できるということだ。

f:id:t-hom:20190915134705p:plain

たとえば変数・分岐・繰り返し・比較演算なんかは、大半の言語が備えている共通概念である。言語によって作法やスタイルが異なるだけで考え方は同じなので、新しく学習する言語でこれらを使いこなすのは難しくない。

仮にVBAを100%マスターしているなら、Pythonの学習範囲はPython特有の部分だけで済む。
f:id:t-hom:20190915140305p:plain

まあそうは言ってもなかなか一つの言語をマスターするのは難しい。
VBAの学習割合が少なければ、Pythonをマスターするための学習範囲はより広くなる。
f:id:t-hom:20190915141208p:plain

じゃあまずはVBAを極めよう!と考えるかもしれないがそれも早計である。
というのも、学習する概念は言語ごとに情報の充実度に差があるためだ。

たとえばVBAはクラスモジュールを使ったオブジェクト指向を一部サポートしているが、VBAでオブジェクト指向を学ぶのは難しい。最近ようやくクラスモジュールを扱う書籍が登場してきたが、まだまだごく一部の上級者向けの書籍にしか解説が無い。

Javaなら、どの入門書にもクラスからオブジェクトを作成する方法が書かれており、その概念も詳しく説明されている。
f:id:t-hom:20190915141856p:plain

ひとつの言語をマスターしようと思ったら、結局、複数の言語をつまみ食いするのが手っ取り早い。


さて、この三連休でPythonの学習を始めてみた。
実はこれまでもPythonを触る機会は何度かあったけど、本格的に入門するのはこれが初めて。

学習に使ってる書籍はこちら。

やさしいPython (「やさしい」シリーズ)

やさしいPython (「やさしい」シリーズ)

学習の際によく混乱するのは次の2点。
・VBAにあるのにPythonに無い概念→「あれ、あの機能は?」と探して時間を浪費する。
・VBAに無くてPythonにある概念→「ナニコレ?」となり理解に時間がかかる。

f:id:t-hom:20190915140824p:plain


ただまぁ、VBAにあるのにPythonに無い概念ってそうそう無くて、これまで同じサイズの円で説明してきたけど実際にはこんなイメージ。
f:id:t-hom:20190915143641p:plain

1998年から基本的な言語機能が進化してないVBAと、現在も新機能を取り込みながら進化を続ける言語を比べたら、当然後者の方が覚えることは多い。

とはいえ、VBAで獲得済みの共通概念だけでPythonコードを書くことはできるので、一応、ひとつプログラミング言語をマスターしたら他の言語でも書けるとは言える。

一方で、人のコードを読むとなると一気にハードルは上がる。ふつう、人は便利な言語機能があればそれを使うので、VBAに無い概念も遠慮なく使用されているハズで、ネットのコードをパクってきて弄ろうと思ってもまぁよく分からないと思う。

よって、その言語を使ってチームで仕事をするっていうレベルに到達するには、未獲得の概念をしっかり学習する必要がある。

つまり表題の件、趣味のレベルで良いならTrue、仕事にするならFalseというのが私の結論。

以上。

VBAで外部ツールを使わずに簡易テスト駆動開発をやってみる。

最近会社の会議でTDDが話題になった。
TDDとは何か?まずWikipediaを引用してみる。

テスト駆動開発 (てすとくどうかいはつ、test-driven development; TDD) とは、プログラム開発手法の一種で、プログラムに必要な各機能について、最初にテストを書き(これをテストファーストと言う)、そのテストが動作する必要最低限な実装をとりあえず行った後、コードを洗練させる、という短い工程を繰り返すスタイルである。

テスト駆動開発 - Wikipedia

話題になったのは、「プログラムできてないのにテストを書けるの?」ということ。
答えは「Yes」

イメージとしては成果物が満たすべき要件を、最初からテストの形式で定義する感じ。

ちょっとやってみよう。

例えば数値を与えるとExcelの列記号に変換するプログラムを考える。

成果物イメージ

以下は成果物をイメージしやすくするためのサンプルコード。
フェイクなので、1~26(A~Z)しか対応していない。

コード

Sub FakeNumToC()
    n = InputBox("数値を入力してください")
    MsgBox "列番号は" & Chr(Asc("A") - 1 + n) & "です。"
End Sub

実行結果

数値入力を求められ、
f:id:t-hom:20190811105258p:plain

入力すると列番号が表示される。
f:id:t-hom:20190811105315p:plain

ただしコードをテスト可能にするには、メインコードからロジックを分離して、ロジック部分を関数にしておく必要がある。
先ほどの成果物イメージで説明すると、以下のようなコードになる。

Sub Main()
    n = InputBox("数値を入力してください")
    MsgBox "列番号は" & FakeNumToC(n) & "です。"
End Sub

Function FakeNumToC(n) As String
    FakeNumToC = Chr(Asc("A") - 1 + n)
End Function

テスト駆動開発の準備

以下のコードがテスト駆動開発の準備。
先ほどのコードと類似しているが、一から作ったという体裁を想定している。
Fakeが付いてなかったり、戻り値が適当だったり、TestNumToCというプロシージャが追加されていたりする。

Sub Main()
    n = InputBox("数値を入力してください")
    MsgBox "列番号は" & NumToC(n) & "です。"
End Sub

Function NumToC(n) As String
    '適当な戻り値
    NumToC = "A"
End Function

Sub TestNumToC()
    'ここにテストを書いていく。
End Sub

関数のゴールをイメージする。

テスト駆動を始める前に、NumToCがどうなったら完成なのか?まずはそのゴールをイメージする。
言葉で表すと、「列番号を与えて、正しい列記号が返ってきたら完成」である。

次に正しい戻り値のケースを具体的に挙げてみる。
「1に対する"A"
2に対する"B"
3に対する"C"
4に対する"D"
5に対する"E"
…」
順番に挙げ始めるとキリがない。
だから普通は、以下のようにパターンが変化するタイミングをサンプリングする。

「1に対する"A"
2に対する"B"

26に対する"Z"
27に対する"AA"
28に対する"AB"

52に対する"AZ"
53に対する"BA"

702に対する"ZZ"
703に対する"AAA"
704に対する"AAB"

かなり泥臭い作業である。
ただこの泥臭さがテストの本質なのでそこは諦めるしかない。

テストを書く

先ほどのコードのうち、TestNumToCプロシージャにテストコードを書いて

Sub Main()
    n = InputBox("数値を入力してください")
    MsgBox "列番号は" & NumToC(n) & "です。"
End Sub

Function NumToC(n) As String
    '適当な戻り値
    NumToC = "A"
End Function

Sub TestNumToC()
    'ここにテストを書いていく。
    Debug.Assert NumToC(1) = "A"
    Debug.Assert NumToC(2) = "B"
    
    Debug.Assert NumToC(26) = "Z"
    Debug.Assert NumToC(27) = "AA"
    Debug.Assert NumToC(28) = "AB"
    
    Debug.Assert NumToC(52) = "AZ"
    Debug.Assert NumToC(53) = "BA"
    
    Debug.Assert NumToC(702) = "ZZ"
    Debug.Assert NumToC(703) = "AAA"
    Debug.Assert NumToC(704) = "AAB"
End Sub

Debug.Assert命令はFalseを与えると中断モードになる命令である。
ここではNumToC関数に引数を与えて、その戻り値と予想値(イコールの右辺)を比較している。
これで戻り値が異なった場合は、そこで停止してテスト失敗ということ。
書いてる内容は至極シンプル。ただ泥臭い作業である。

実行するとここでテスト失敗。
f:id:t-hom:20190811112659p:plain

NumToCは今のところ常に"A"を返すので、当然失敗する。
ここで失敗するというのはひとつの確認ポイントで、もし中断モードに入らなかったら何かが間違っている。
メインコードができていないのにテストにパスしたらそのテストコードがおかしいということになる。

これでテストファーストは完了。
メインのロジックであるNumToCは全然完成していない。
にもかかわらず、テストコードは書けている。

「プログラムできてないのにテストを書けるの?」
「Yes」

メインコードを書く

ここからは普通にNumToCの中身を書けば良いだけ。
ただし先にテストコードが作ってあるので、検証はすこぶる簡単。

まずは冒頭で作ったFakeNumToCのロジックを流用してみる。

Function NumToC(n) As String
    NumToC = Chr(Asc("A") - 1 + n)
End Function

テストコードを実行すると、以下で止まる。
f:id:t-hom:20190811113507p:plain


ああでもないこうでもないと弄り。。

Function NumToC(n) As String
    If n > 26 Then
        nn = n \ 26
        n = n Mod 26
        
        ret = Chr(Asc("A") - 1 + nn) & ret
    End If
    ret = Chr(Asc("A") - 1 + n) & ret
    NumToC = ret
End Function

やっぱりコケる。
f:id:t-hom:20190811114402p:plain


自前でロジック組むのを諦めてExcelのオブジェクトに頼る。

Function NumToC(n) As String
    NumToC = Split(Cells(1, n).Address, "$")(1)
End Function

これでTestNumToCを実行すると、何も起きなくなった。
実行できてるのか不安なのでテストプロシージャの最後にMsgBox "Test Finished"を入れるようにした。

テスト駆動のメリット

  • テストを先に書くことによってメインコードを書いているときに何度でもテストできるので、タイムリーに間違いを発見でき、手戻りが減らせる。
  • メインコードが書きあがってからもっとスマートにしたいと思ったときに、テストしながらできるのでロジックを壊さずに済む。
  • コードの安全性について説明可能になる。

テストケースの抽出方法

今回はテスト駆動開発の紹介がメインなので、テストケースはかなり大雑把。
専門的には同値分割・境界値分析といった技法があるので詳しく知りたい方は専門書をどうぞ。
※以下の記事で簡単には触れてます。
thom.hateblo.jp

ちなみに今回のケースであれば以下の記事にテストパターンが列挙されているのでオススメ。
www.excel-chunchun.com

以上

VBA 開発中マクロブックのバックアップを取るマクロ

開発中のマクロで、こまめに保存しておきたいケースがあったのでコードを書いてみた。
これは開発中のブックに埋め込んで利用する前提。私は標準モジュール「DevTools」に保存して使っている。

Sub BackupFile()
    'Microsoft Scripting Runtimeへの参照設定が必要
    Dim fso As FileSystemObject: Set fso = New FileSystemObject
    With ThisWorkbook
        Dim f As File: Set f = fso.GetFile(.FullName)
        Dim backupFolderPath As String: backupFolderPath _
            = .Path & "\backup_" & Left(f.Name, Len(f.Name) - Len(fso.GetExtensionName(f.Path)) - 1)
        If Not fso.FolderExists(backupFolderPath) Then fso.CreateFolder backupFolderPath
        .SaveCopyAs backupFolderPath & "\" & Format(Now, "yyyymmddhhMMss") & "_" & .Name
    End With
End Sub

実行すると、そのブックと同じパスにbackup_[ブック名(拡張子除く)]というフォルダーが作成され、編集中のブックのコピーが保存される。

ファイル名は秒単位なので1秒に複数回実行すると古いコピーが上書きされてしまうことに注意。
(そんな頻度で実行するシチュエーションは無いと思うが)

いつもなら少し大掛かりなマクロではGitHubを使ってバージョン管理するんだけど、今回はブック本体に公開できない情報を含むので、ファイルのコピーを残すという原始的なバックアップに頼ることにした。

このくらいのコードならTwitterに投稿しようとしたら文字数限界だったので記事にした次第。

Excel VBAでスクロール可能なフォームのアイデア

Excel VBAでフォームを作る際に、項目が多くてウインドウの高さに収まりきらないことがある。
そこで今回はスクロールによってフォーム全体をウインドウに収めるアイデアを紹介する。

言葉では何がやりたいのか伝わりにくいと思うのでまずは動作イメージから。

動作イメージ

f:id:t-hom:20190505103218g:plain

注意事項

あくまでアイデアなので、実用化にはまだ色々と工夫が必要になる。
今のままではデータの取り出しすらままならないのだが、本記事のコードを読める人なら自分で実装できると思われる。

コード

クラスモジュール「FieldLocator」

まずはクラスモジュールを挿入し、オブジェクト名をFieldLocatorとする。
このFieldLocatorはデータフィールド用のテキストボックスとそのラベルを生成し、座標を管理するオブジェクトだ。
最初のFieldLocatorから次のFieldLocatorへ、そこからまた次のFieldLocatorへと参照が張られ、とリスト構造(数珠状)でつながる仕組み。
1カラムのテキストボックス、2カラムのテキストボックスのみ対応している。

コードはこちら。

'DEBUG_MODEはラベルを配置するときに色が付いてないとサイズが分かりづらいので作った。
'Falseにすると色付け無しになる。
#Const DEBUG_MODE = False
Private top_ As Long
Public Left As Long
Public FieldName1 As String
Public FieldName2 As String
Public LabelWidth As Integer
Public LineCount As Integer
Public L1 As MSForms.Label, L2 As MSForms.Label
Public T1 As MSForms.TextBox, T2 As MSForms.TextBox

'すべてのFieldLocatorは最初のアイテムからNextItemを辿って数珠状につながる想定。
'これにより、最初のアイテムのTopプロパティーを変更すると、連鎖的に他のアイテムのTopプロパティーも変わる。
'つまり全てのコントロールが最初のアイテムに連動して動くので、スクロールバーで動かすのは最初のアイテムだけでOKになる。
Public NextItem As FieldLocator

Const FONT_SIZE = 12, FONT_HEIGHT = 15, FONT_MARGIN = 6

Private Sub Class_Initialize()
    Me.LineCount = 1
    Me.LabelWidth = 100
End Sub
Public Property Get Self() As FieldLocator
    Set Self = Me
End Property

Public Function CreateNext() As FieldLocator
    With New FieldLocator
        .Top = Me.Bottom + 10
        .Left = Me.Left
        .LabelWidth = Me.LabelWidth
        Set NextItem = .Self
        Set CreateNext = NextItem
    End With
End Function

Public Property Let Top(t_ As Long)
    top_ = t_
    If Not T1 Is Nothing Then
        CCnt(T1).Top = t_
        CCnt(L1).Top = CCnt(T1).Top + 2
        If Not T2 Is Nothing Then
            CCnt(T2).Top = CCnt(T1).Top
            CCnt(L2).Top = CCnt(L1).Top
        End If
    End If
    If Not NextItem Is Nothing Then
        NextItem.Top = Me.Bottom + 10
    End If
End Property
Public Property Get Top() As Long
    If T1 Is Nothing Then
        Top = top_
    Else
        Top = CCnt(T1).Top
    End If
End Property
Public Property Get Bottom() As Long
    Bottom = CCnt(T1).Top + CCnt(T1).Height
End Property

Sub AddInputBox(f As UserForm)
    Set L1 = f.Controls.Add("Forms.Label.1")
    L1.Font.Name = "Meiryo UI"
    L1.Font.Size = FONT_SIZE
    CCnt(L1).Height = FONT_HEIGHT + FONT_MARGIN
    CCnt(L1).Width = LabelWidth
    CCnt(L1).Left = Left
    L1.TextAlign = fmTextAlignRight
    L1.Caption = FieldName1
#If DEBUG_MODE Then
    L1.BackColor = rgbLightYellow
#End If
    
    Set T1 = f.Controls.Add("Forms.Textbox.1")
    T1.BorderStyle = fmBorderStyleSingle
    T1.Font.Name = "Meiryo UI"
    T1.Font.Size = FONT_SIZE
    T1.MultiLine = LineCount > 1
    T1.ScrollBars = fmScrollBarsVertical
    T1.EnterKeyBehavior = LineCount > 1
    CCnt(T1).Height = FONT_HEIGHT * LineCount + FONT_MARGIN
    CCnt(T1).Width = 450
    CCnt(T1).Left = CCnt(L1).Left + CCnt(L1).Width + 10
    CCnt(T1).Top = top_
    
    CCnt(L1).Top = CCnt(T1).Top + 2
End Sub

Sub AddTwinInputBox(f As UserForm)
    Set L1 = f.Controls.Add("Forms.Label.1")
    L1.Font.Name = "Meiryo UI"
    L1.Font.Size = FONT_SIZE
    CCnt(L1).Height = FONT_HEIGHT + FONT_MARGIN
    CCnt(L1).Width = LabelWidth
    CCnt(L1).Left = Left
    L1.TextAlign = fmTextAlignRight
    L1.Caption = FieldName1
#If DEBUG_MODE Then
    L1.BackColor = rgbLightYellow
#End If

    Set L2 = f.Controls.Add("Forms.Label.1")
    L2.Font.Name = "Meiryo UI"
    L2.Font.Size = FONT_SIZE
    CCnt(L2).Height = FONT_HEIGHT + FONT_MARGIN
    CCnt(L2).Width = LabelWidth
    L2.TextAlign = fmTextAlignRight
    L2.Caption = FieldName2
#If DEBUG_MODE Then
    L2.BackColor = rgbLightYellow
#End If
    
    Set T1 = f.Controls.Add("Forms.Textbox.1")
    T1.BorderStyle = fmBorderStyleSingle
    T1.Font.Name = "Meiryo UI"
    T1.Font.Size = FONT_SIZE
    T1.MultiLine = LineCount > 1
    T1.ScrollBars = fmScrollBarsVertical
    T1.EnterKeyBehavior = LineCount > 1
    CCnt(T1).Height = FONT_HEIGHT * LineCount + FONT_MARGIN
    CCnt(T1).Width = (450 - 20 - LabelWidth) / 2
    CCnt(T1).Left = CCnt(L1).Left + CCnt(L1).Width + 10
    CCnt(T1).Top = top_
    
    CCnt(L1).Top = CCnt(T1).Top + 2
    CCnt(L2).Left = CCnt(T1).Left + CCnt(T1).Width + 10
    CCnt(L2).Top = CCnt(L1).Top
    
    Set T2 = f.Controls.Add("Forms.Textbox.1")
    T2.BorderStyle = fmBorderStyleSingle
    T2.Font.Name = "Meiryo UI"
    T2.Font.Size = FONT_SIZE
    T2.MultiLine = LineCount > 1
    T2.ScrollBars = fmScrollBarsVertical
    T2.EnterKeyBehavior = LineCount > 1
    CCnt(T2).Height = FONT_HEIGHT * LineCount + FONT_MARGIN
    CCnt(T2).Width = CCnt(T1).Width
    CCnt(T2).Left = CCnt(L2).Left + CCnt(L2).Width + 10
    CCnt(T2).Top = top_
End Sub

Private Function CCnt(o As Object) As MSForms.Control
    Set CCnt = o
End Function

フォームモジュール

ユーザーフォームを挿入し、次のコードを張り付ける。
フォームのオブジェクト名は任意で良い。

Dim FirstField As FieldLocator
Private WithEvents ScrollBar1 As MSForms.ScrollBar
Private Sub ScrollBar1_Change()
    'ScrollBarはマイナス値をMaxに設定すると、増分がマイナスになるので、
    '次のようにシンプルに書ける。
    FirstField.Top = ScrollBar1.Value
End Sub

Private Sub UserForm_Initialize()
    Set ScrollBar1 = Me.Controls.Add("Forms.ScrollBar.1")
    Const GOLDEN_RATIO = 1.618
    Me.Width = 800 '所有してるモニタの最低解像度の横幅が800(SVGA)なので。ちなみに最高は1920。
    Me.Height = Me.Width / GOLDEN_RATIO '黄金比を用いて収まりよく。
    ScrollBar1.Width = 20
    ScrollBar1.Left = Me.Width - 25
    ScrollBar1.Height = Me.Height - 22
    ScrollBar1.SmallChange = 5
    ScrollBar1.LargeChange = 20
    With New FieldLocator
        '最初の作成で設定する
        Set FirstField = .Self
        .Top = 30
        ScrollBar1.Min = .Top
        .Left = 100
        .LabelWidth = 80
        
        '以降の設定項目は共通
        .FieldName1 = "件名"
        .LineCount = 1 'LineCountは省略すると1になる。
        .AddInputBox Me 'これは1カラムの入力フィールドを追加するコマンド
        
    '以降はCreateNextのメソッドチェーンでFieldLocatorを数珠状に作っていく。
    With .CreateNext
        .FieldName1 = "概要"
        .LineCount = 2
        .AddInputBox Me
    With .CreateNext
        .FieldName1 = "詳細"
        .LineCount = 10
        .AddInputBox Me
    With .CreateNext
        '2カラムの入力フィールドの場合はこうする。
        .FieldName1 = "開始日"
        .FieldName2 = "有効期限"
        .AddTwinInputBox Me
    With .CreateNext
        .FieldName1 = "担当者"
        .AddInputBox Me
    With .CreateNext
        .FieldName1 = "連絡先"
        .AddInputBox Me
    With .CreateNext
        .FieldName1 = "備考欄"
        .LineCount = 10
        .AddInputBox Me
    With .CreateNext
        .FieldName1 = "その他"
        .AddInputBox Me
        
        '最後の要素のBottomを利用してScrollBarのMax値
        '(プロパティ名はMaxだが、実際にはマイナス値なので最小)を決定する。
        ScrollBar1.Max = Me.Height - .Bottom - 30
    
    'メソッドチェーンが終わると、残念ながら大量のEnd With文
    End With: End With: End With: End With: End With: End With: End With: End With
End Sub

フォーム自体を除き、パーツはすべてコードで生成する為、フォーム上には何も配置しなくて良い。
サイズもコードで指定するのでそのままで良い。
フォームを起動すると冒頭の動作イメージのとおり操作できる。

あとがき

Access Formを使えばこんなことは朝飯前なんだけど、Excelにちょっとしたフォームが欲しくなることもある。
標準のフォーム機能ってのもあった気がするけど、使い勝手がとても悪いので、自作を試みているところ。

ちょっとしたフォームにしては作り方が大掛かりに見えるかもしれないが、使いまわしができ、デザインの微調整が必要なく、単に項目を指定していくだけで完成する汎用的なフォーム作成が目的なので、この手間は仕方がない。

おまけ

以下はスクロールバーをMin 0% Max 100%のパーセンテージで管理しようともがいてる図。
f:id:t-hom:20190505105800p:plain
結局、Maxをマイナス値にするとマイナスに向かって進むことが判明し、コードをよりシンプルに出来るのでパーセンテージ管理は没になった。


以下はHeight Managerというオブジェクトでラベルとテキストボックスを管理し、双方向ポインタで結ぶことで先頭を動かすと全体が動く仕組みを作ろうとした図。
f:id:t-hom:20190505105828p:plain
このアイデアは別の形(FieldLocator)で実現した。実際には片方向ポインタで十分だった。
上下のボーダーを跨ぐとコントロールを非表示にするアイデアだったが実装に至っていない。

現在はスクロールによってフォームの上端・下端でコントロールが見えなくなるが、本当はZOrderをトップにしたラベルの下に潜り込ませて、完全に潜ったらHiddenにしようと考えている。ちょっと管理すべき項目が多くて混乱中。

VBA 連続して与えられた数の最大値、最小値を求めるクラス

今回は連続して値を投げ込み、その最大値・最小値を求めるクラスを紹介する。
かなりシンプルなのでわざわざ記録しておくこともないかなと迷ったけど、クラス初心者向けにはちょうど良いサンプルになりそうなのでとりあえず。

クラスモジュールのコード

クラス名はNumericAggregationObjectとし、次のコードを張り付ける。

Public Data As Collection
Public Max As Variant
Public Min As Variant
Public Sum As Variant
Public Property Get Avg() As Variant
    Avg = Sum / Data.Count
End Property

Sub Add(x As Variant)
    If Data.Count = 0 Then
        Max = x
        Min = x
    End If
    If Max < x Then Max = x
    If Min > x Then Min = x
    Sum = Sum + x
    Data.Add x
End Sub

Private Sub Class_Initialize()
    Set Data = New Collection
    Max = 0
    Min = 0
    Sum = 0
End Sub

まぁ見ての通り、オブジェクト外からデータ書き換えし放題のゆるゆるクラス。
個人で使うには十分だけど、クリティカルな業務で使おうと思ったらPropertyでアクセサ作って不正データブロックするなり、もう少しセキュアにした方が良い。

使い方

こちらのサンプル参照。

Sub Sample()
    Dim nao As NumericAggregationObject
    Set nao = New NumericAggregationObject
    nao.Add 10
    nao.Add 12
    nao.Add 9
    Debug.Print "Max:" & nao.Max
    Debug.Print "Min:" & nao.Min
    Debug.Print "Sum:" & nao.Sum
    Debug.Print "Avg:" & nao.Avg
End Sub

動機

これを作った動機はExcel VBAのユーザーフォーム設計で、テキストボックスの最適幅を求める課題が生じたこと。
f:id:t-hom:20190504101018p:plain

Meiryo UIはプロポーショナルフォントなので、テキストの内容によって幅が伸縮する。
以前は以下のテキストを使用して幅を作っていたんだけど、実際に自然な文章を入れてみると幅が結構ズレるので、今回は実際の文章を使って最大幅を見つけることにした。
"■■■■■□□□□□■■■■■□□□□□■■■■■□□□□□■■■■■□□□□□"

どうやってやったかは、以下のとおり。

1) ブログから適当な文章を持ってきてSheet1のA1セルに張り付ける。
f:id:t-hom:20190504102208p:plain
2) 改行を除去
f:id:t-hom:20190504102326p:plain
f:id:t-hom:20190504102353p:plain
3) 以下の記事から幅取得用のモジュールを準備
thom.hateblo.jp
※使うのはMeasureTextWidth関数
4) 80バイト切り出したときの最大幅を取得

Sub 最大幅取得()
    Dim t As String
    t = String(80, "*")
    Dim n As Long: n = 1
    Dim nao As NumericAggregationObject
    Set nao = New NumericAggregationObject
    Do While LenB(t) >= 80
        t = MidB(Sheet1.Range("A1"), n, 80)
        w = MeasureTextWidth(t, "Meiryo UI")
        nao.Add w
        n = n + 2
    Loop
    Debug.Print nao.Max
End Sub

実行結果は283と出た。

5) 最大幅に合致する文を取得

Sub 最大幅に合致する文を取得()
    Const 最大幅 = 283
    Dim t As String
    t = String(80, "*")
    n = 1
    Do While LenB(t) >= 80
        t = MidB(Sheet1.Range("A1"), n, 80)
        w = MeasureTextWidth(t, "Meiryo UI")
        If w = 最大幅 Then Debug.Print t
        n = n + 2
    Loop
End Sub

実行結果は「の呼び出し履歴は、一番上が中断したプロシージャ、二番目がその呼び出し元、三番目が」となった。

6) この文をテキストボックスのTextプロパティに入れて、ぎりぎり入る幅にする。
テキストボックスのWidthプロパティを見て、キリの良い数字に切り上げる。(450にした)

以上

これでまぁ大半のテキストはうまく収まると思われる。

ちなみにこれで、私が作るユーザーフォームは基準値が出そろった。

Font.Name Meiryo UI
Font.Size 12
BorderStyle fmBorderStyleSingle
Height 15 × 行数 + 6
Width(最大) 450(1カラムレイアウト時)

Heightの計算式の根拠については以下の記事を参照
thom.hateblo.jp

Font.Sizeの根拠については以下の記事を参照
thom.hateblo.jp

VBA 呼び出し履歴を使ったデバッグ

VBEditorには呼び出し履歴という機能がある。

たとえば、プロシージャProcAからプロシージャProcBを呼び出した際にProcBで実行時エラーを吐いて中断したとする。
このとき、中断モードでプロシージャ呼び出しを遡ることができる機能である。

本記事ではこれを使ったデバッグテクニックを紹介する。

まず次のコードを実行してみる。

Sub ProcA()
    For i = -5 To 5
        Call ProcB(i)
    Next
End Sub

Sub ProcB(x)
    Debug.Print 100 / x
End Sub

するとゼロ除算エラーが発生する。ここでデバッグをクリックすると、
f:id:t-hom:20190330122236p:plain

エラーが発生した行で中断モードになる。
f:id:t-hom:20190330122332p:plain

ここでxが0だからエラーになったのは自明である。
カーソルを乗せるか、イミディエイトウインドウで「?x」と入力すればxが0であることが分かる。

しかしなぜxが0になったのかが分からないことも多い。
今回はサンプルなのでiが0だからに決まってるじゃないかと思われるかもしれないが、実務コードは複雑なのですぐに気づかないこともある。

しかし、この状態でイミディエイトウインドウで「?i」と入力しても、空文字が返るだけ。
呼び出し元のiを知るには、iにカーソルを当てるという方法もあるが、もう少し複雑な検証をしたい場合もある。

ここで呼び出し元スコープに戻るためには、Ctrl+Lで呼び出し履歴ウィンドウを開く。(表示メニューからでもOK)
f:id:t-hom:20190330122857p:plain

この呼び出し履歴は、一番上が中断したプロシージャ、二番目がその呼び出し元、三番目がさらにそれの呼び出し元というふうに下に行くほど呼び出しを遡ることができる。

呼び出し元を表示させると、グリーンのカーソルで呼び出し元コードが示される。このときローカルウインドウを表示させると呼び出し元スコープ(ProcA)の変数が表示されているのが分かる。
f:id:t-hom:20190330123102p:plain

つまり呼び出し履歴を使用することで、実行エラー発生する条件を呼び出し元に遡って分析することができる。

ここでProcAのiは参照渡しでProcBのxに格納されているので、ローカルウインドウやイミディエイトウインドウで直接値を書き換えると、xの値も変わる。試しにiを1に書き換えてからF5キーで続行すると正しくマクロ実行を継続することができる。
※もし値渡しだった場合は呼び出し元のProcAでiを書き換えてもxは書き換わらないので注意。

以上

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