○箇月後の直近の○曜日は？

○箇月後の○曜日の日付を求める自作Function

「１箇月後の直近の木曜日を求める」という作業が発生した。別に、暦を見たらいいんだけれど、もし今後たくさんの日付について同じ作業をする必要が生じたらメンドウなので、ちょこちょこっと「１箇月後の直近の木曜日の日付」を返すFunctionプロシージャを作ってみた。

ただ、「１箇月後の直近の木曜日」にしか対応できないのではツマラナイので、

せめて○箇月後の○曜日ぐらいにはに対応できるようにしておこう

と思い立って、ちょこちょこっと書いてみた。

考え方

VBAには、組み込み定数でvbSunday（正体は"1"）～vbSaturday（正体は"7"）が定められている。

○箇月後の日付は、元の日付がtargetDateという変数に入っているとすると、

DateSerial(Year(targetDate), Month(targetDate) + ○, Day(targetDate))

で求められる。

で、その返り値（＝○箇月後の日付）がtmpDateという変数に入っているとすると、

Weekday(tmpDate)

で曜日を表す整数（"1"～"7"）が得られる。

あとは、そこから何日ずらせば求めたい曜日にたどり着くかを求め、tmpDateに入っている日付を調整すれば良いだけ。

それぞれの曜日をいくつずらせば求めたい曜日にたどり着くか、というのは規則性のあることなので、一覧表にすれば一般的な計算式が導き出せる。

○箇月後の曜日＼目的の曜日	vbSunday(1)	vbMonday(2)	vbTuesday(3)	vbWednesday(4)	vbThursday(5)	vbFriday(6)	vbSaturday(7)
vbSunday(1)	０	＋１	＋２	＋３	－３	－２	－１
vbMonday(2)	－１	０	＋１	＋２	＋３	－３	－２
vbTuesday(3)	－２	－１	０	＋１	＋２	＋３	－３
vbWednesday(4)	－３	－２	－１	０	＋１	＋２	＋３
vbThursday(5)	＋３	－３	－２	－１	０	＋１	＋２
vbFriday(6)	＋２	＋３	－３	－２	－１	０	＋１
vbSaturday(7)	＋１	＋２	＋３	－３	－２	－１	０

とまあ、こんな感じ。

目的の曜日を ｘ 、○箇月後の曜日を ｙ とすると、

1. ｘ－ｙ＞３のとき　（ｘ－ｙ）－７
2. －３≦ｘ－ｙ≦３のとき　ｘ－ｙ
3. ｘ－ｙ＜－３のとき　（ｘ－ｙ）＋７

で、それぞれ目的の曜日にするためにずらす日数が求められる。

コーディング

上記のことを踏まえてコーディングする。

引数は、

1. 元の日付
2. 何箇月後か
3. 直近の何曜日か

の３つ。もちろん、返り値は「○箇月後の○曜日の日付」である。

リスト１　標準モジュール

Option Explicit

Public Function calcAnyWeekdayAfterAnyMonths(ByVal targetDate As Date, _
                                             ByVal months As Integer, _
                                             ByVal weekDayAt As Integer) As Date
  If weekDayAt < 1 Or weekDayAt > 7 _
    Then Err.Raise 10001, "引数weekDayが不正です。"    '……(1)'
  Dim tmpDate As Date
  tmpDate = DateSerial(Year(targetDate), _
                       Month(targetDate) + months, _
                       Day(targetDate))    '……(2)'
  Dim objWeekday As Integer
  objWeekday = Weekday(tmpDate)    '……(3)'
  Dim adjustDateBy As Integer
  adjustDateBy = calcWeekday(weekDayAt, objWeekday)    '……(4)'
  calcAnyWeekdayAfterAnyMonths = tmpDate + adjustDateBy    '……(6)'
End Function

Private Function calcWeekday(ByVal tgtWeekday As Integer, _
                             ByVal objWeekday As Integer) As Integer    '……(5)'
  If (tgtWeekday - objWeekday) > 3 Then calcWeekday = tgtWeekday - objWeekday - 7: Exit Function
  If (tgtWeekday - objWeekday) >= -3 And _
     (tgtWeekday - objWeekday) <= 3 Then calcWeekday = tgtWeekday - objWeekday: Exit Function
  If (tgtWeekday - objWeekday) < -3 Then calcWeekday = tgtWeekday - objWeekday + 7
End Function

(1)の

If weekDayAt < 1 Or weekDayAt > 7 Then Err.Raise 10001, "引数weekDayが不正です。"

では、第３引数を調べ、整数の１～７以外が渡されていたらエラーを吐くようにしている。

(2)の

tmpDate = DateSerial(Year(targetDate), _
                       Month(targetDate) + months, _
                       Day(targetDate))

では、DateSerial関数によって、「months」箇月後の日付を取得。

(3)の

objWeekday = Weekday(tmpDate)

で「months」箇月後の日の曜日を取得。ちなみに、DateSerial関数を使っているので、例えば「１月30日の１箇月後」は、「２月30日」、すなわち平年ならば「３月２日」ということになるので注意。

ここまでで、「months」箇月後の曜日、目的の曜日の２つが判明しているので、(4)の

adjustDateBy = calcWeekday(weekDayAt, objWeekday)

で、これまた自作のcalcWeekday関数に２つの曜日を表す整数を渡して、調整すべき日数を求める。

(5)の

Private Function calcWeekday(ByVal tgtWeekday As Integer, _
                             ByVal objWeekday As Integer) As Integer
  If (tgtWeekday - objWeekday) > 3 Then calcWeekday = tgtWeekday - objWeekday - 7: Exit Function
  If (tgtWeekday - objWeekday) >= -3 And _
     (tgtWeekday - objWeekday) <= 3 Then calcWeekday = tgtWeekday - objWeekday: Exit Function
  If (tgtWeekday - objWeekday) < -3 Then calcWeekday = tgtWeekday - objWeekday + 7
End Function

で調整すべき日数を求める。３つの場合分けで、それぞれ計算方法を分岐。If～ElseIf～Elseで書けるけれど、そうすると読みづらくなるので、ガード節っぽい書き方で３つのIf文を連ねる形にした。

あとは、(6)の

calcAnyWeekdayAfterAnyMonths = tmpDate + adjustDateBy

で日数を調整して、結果を返す。

実行結果

2017年10月３日の１箇月後の直近の木曜日は、

このとおり。

2017年10月３日の２箇月後の直近の金曜日は、

このとおり。

2017年10月３日の３箇月後の直近の水曜日は、

このとおり。

おわりに

まあ、ここまでやったところで、使い道があるかどうかは不明ｗ

「車輪の再発明」でないことを祈る。

@akashi_keirin on Twitter

改訂しました

コチラもどうぞ。

akashi-keirin.hatenablog.com

WordドキュメントのPDF化ツール――だいぶ本格的になりました

自作ツール「かんたんPDF変換」

３種類のPDF変換をこなすツールを自作した

akashi-keirin.hatenablog.com

akashi-keirin.hatenablog.com

上記の記事で、Wordドキュメントを編集中にサクッとPDF化するマクロを作ったわけだが、

いっそちゃんとしたツールとして作ってしまおう

と思って、作ってみた。

実行するとこんなユーザーフォームが出てきて、

• ドキュメント全体
• 現在カーソルがあるページのみ
• 指定したページ範囲

のどれかを選んで実行すると、指定の形でPDFファイルをサクッと吐き出すというもの。

作り方

まず、ユーザーフォームを挿入し、画像のように各コントロールを貼り付ける。

めんどくさいので、フォーム、各コントロールのサイズや位置に関するプロパティは目分量ｗ

フォーム及び各コントロールのオブジェクト名は画像の通り。

いちおう一覧表にもしておこう。

フォーム・各コントロールのオブジェクト名

フォーム・コントロール	オブジェクト名
ユーザーフォーム	FrmMain
フレーム	FrameMain
オプションボタン	OptBtnWhole
オプションボタン	OptBtnCurrent
オプションボタン	OptBtnSelect
コマンドボタン	BtnStart
コマンドボタン	BtnCancel
テキストボックス	TxtBoxFrom
スピンボタン	SpinBtn1
ラベル	Label1
テキストボックス	TxtBoxTo
スピンボタン	SpinBtn1

これだけ準備しておいて、お次はコーディング。

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

だいぶ長くなるよ。

Option Explicit
Private currentPage As Integer
Private numOfPagesInDocument As Integer

Private Sub UserForm_Initialize()
  currentPage = Selection.Information(wdActiveEndPageNumber)
  numOfPagesInDocument = Selection.Information(wdNumberOfPagesInDocument)
  With Me
    .OptBtnWhole = True
    Call unablePageSelect
  End With
End Sub

Private Sub unablePageSelect()
  With Me
    .SpinBtn1.Enabled = False
    .SpinBtn2.Enabled = False
    .TxtBoxFrom.Enabled = False
    .TxtBoxTo.Enabled = False
  End With
End Sub

Private Sub BtnCancel_Click()
  Unload Me
End Sub

Private Sub BtnStart_Click()
  With Me
    If .OptBtnWhole.Value _
      Then Call convertDocumentToPDF
    If .OptBtnCurrent.Value _
      Then Call convertActivePageToPDF(currentPage)
    If .OptBtnSelect.Value _
      Then Call convertSelectedPagesToPDF(.TxtBoxFrom.Value, _
                                          .TxtBoxTo.Value)
  End With
  Unload Me
End Sub

Private Sub OptBtnWhole_Change()
  If OptBtnWhole.Value Then Call unablePageSelect
  If OptBtnCurrent.Value Then Call unablePageSelect
End Sub

Private Sub OptBtnCurrent_Change()
  If OptBtnWhole.Value Then Call unablePageSelect
  If OptBtnCurrent.Value Then Call unablePageSelect
End Sub

Private Sub OptBtnSelect_Change()
  If OptBtnWhole.Value Then Call unablePageSelect
  If OptBtnCurrent.Value Then Call unablePageSelect
  If OptBtnSelect.Value Then Call enablePageSelect
End Sub

Private Sub enablePageSelect()
  With Me
    .SpinBtn1.Enabled = True
    .SpinBtn2.Enabled = True
    .TxtBoxFrom.Enabled = True
    .TxtBoxFrom.Value = currentPage
    .TxtBoxTo.Enabled = True
    .TxtBoxTo.Value = numOfPagesInDocument
  End With
End Sub

Private Sub SpinBtn1_SpinDown()
  With Me.TxtBoxFrom
    If CInt(.Value) > 1 Then
      .Value = .Value - 1
    End If
  End With
End Sub

Private Sub SpinBtn1_SpinUp()
  With Me.TxtBoxFrom
    If CInt(.Value) < CInt(Me.TxtBoxTo.Value) Then
      .Value = .Value + 1
    End If
  End With
End Sub

Private Sub SpinBtn2_SpinDown()
  With Me.TxtBoxTo
    If CInt(.Value) > CInt(Me.TxtBoxFrom.Value) Then
      .Value = .Value - 1
    End If
  End With
End Sub

Private Sub SpinBtn2_SpinUp()
  With Me.TxtBoxTo
    If CInt(.Value) < CInt(Selection.Information(wdNumberOfPagesInDocument)) Then
      .Value = .Value + 1
    End If
  End With
End Sub

Private Sub convertDocumentToPDF()
  '///アクティブドキュメントをPDF化する。'
  Dim objDoc As Document
  Set objDoc = ActiveDocument
  Dim pathStr As String
  pathStr = objDoc.FullName
  'フルパスから拡張子の「.」の位置を取得。'
  Dim n As Integer
  n = InStrRev(pathStr, ".")
  '「.」の位置を元に、PDFファイルのフルパスを作る。'
  pathStr = Left(pathStr, n) & "pdf"
  With objDoc
    .ExportAsFixedFormat OutputFileName:=pathStr, _
                         ExportFormat:=wdExportFormatPDF
  End With
  Set objDoc = Nothing
End Sub

Private Sub convertActivePageToPDF(ByVal pageNum As Integer)
  '///アクティブページだけをPDF化する。'
  Dim objDoc As Document
  Set objDoc = ActiveDocument
  Dim pathStr As String
  pathStr = objDoc.FullName
  'フルパスから拡張子の「.」の位置を取得。'
  Dim n As Integer
  n = InStrRev(pathStr, ".")
  '「.」の位置を元に、PDFファイルのフルパスを作る。'
  'ページ番号３ケタゼロ埋め文字列をファイル名に付加する。'
  pathStr = Left(pathStr, n - 1) & _
            "_P." & Format(pageNum, "00#") & ".pdf"
  With objDoc
    .ExportAsFixedFormat OutputFileName:=pathStr, _
                         ExportFormat:=wdExportFormatPDF, _
                         Range:=wdExportCurrentPage
  End With
  Set objDoc = Nothing
End Sub

Private Sub convertSelectedPagesToPDF(ByVal pageFrom As Integer, _
                                      ByVal pageTo As Integer)
  '///指定されたページ範囲をPDF化する。'
  Dim objDoc As Document
  Set objDoc = ActiveDocument
  Dim pathStr As String
  pathStr = objDoc.FullName
  'フルパスから拡張子の「.」の位置を取得。'
  Dim n As Integer
  n = InStrRev(pathStr, ".")
  '「.」の位置を元に、PDFファイルのフルパスを作る。'
  'ページ番号３ケタゼロ埋め文字列をファイル名に付加する。'
  pathStr = Left(pathStr, n - 1) & _
            "_P." & Format(pageFrom, "00#") & _
            "-P." & Format(pageTo, "00#") & ".pdf"
  With objDoc
    .ExportAsFixedFormat OutputFileName:=pathStr, _
                         ExportFormat:=wdExportFormatPDF, _
                         Range:=wdExportFromTo, _
                         From:=pageFrom, _
                         To:=pageTo
  End With
  Set objDoc = Nothing
End Sub

実行

エントリーポイントとして、標準モジュールに次のコードを書く。

リスト２　標準モジュール

Public Sub run()
  FrmMain.Show
End Sub

このマクロを書いたファイルを「.dotm」形式で

ユーザー\AppData\Roaming\Microsoft\Word\STARTUP フォルダ

に保存、クイック アクセス ツール バー に登録して実行するようにする。

一連の方法は

akashi-keirin.hatenablog.com

コチラをどうぞ。

こんなドキュメントがあったとして、

こんなふうに条件を指定して[PDF化]ボタンをクリックすると、

一瞬でPDF化できた。

おわりに

なかなか便利なツールに仕上がったんではないでしょうか。

え？　「飛び飛びのページを指定してPDF化したいときはどうするんだよ！？」ですか？

そんなもん、不要なページを削除してからPDF化して、ドキュメントを保存せずに閉じたらいいじゃねーかよ!!!!!!!!

はっ、取り乱しました。

まあ、とりあえず動くこと優先で書き飛ばしたコードなのでムダが多いコードだとは自分でも思いますよ。まあ、ヒマなときにリファクタリングするので、そのときはまたネタにしようかな。

ヒマな人はリファクタリングの練習用にどうぞ。

@akashi_keirin on Twitter

Wordドキュメントの編集中のページをサクッとPDF化する

WordドキュメントのアクティブなページのみPDF化

以前、

akashi-keirin.hatenablog.com

コチラの記事で、クリック一発で編集中のドキュメントをPDF化するマクロを紹介した。

今回は、題名のとおり、

現在アクティブなページのみPDF化

するマクロを考える。

使い道があるかどうかは不明なれどｗ

DocumentオブジェクトのExportAsFixedFormatメソッド

「PDF化」といえば、DocumentオブジェクトのExportAsFixedFormatメソッドの出番。

このメソッド、

実は、ご覧のように異様にたくさんの引数を持っている。その数実に 15。まさに引数祭りｗ

たいていは必須の「OutPutFileName」と「ExportFormat」の２つしか指定しないので、

Document.ExportAsFixedFormat "hogehoge.pdf",wdExportFormatPDF

みたいに記述すると思う。

実は、このメソッドの引数の中には、

Range

という引数がある。

面白いのは、この引数、データ型が

WdExportRange型 という独自の型なんである。

ちょっと調べてみると、WdExportRangeというのは列挙体で、

名前	値	説明
wdExportAllDocument	0	文書全体
wdExportCurrentPage	1	現在のページ
wdExportFromTo	2	開始・終了ページを指定
wdExportSelection	3	現在の選択範囲

それぞれ実際の値と意味するところはこうなっている。

つまり、ExportAsFixedFormatメソッドの引数「Range」に「wdExportCurrentPage（正体は整数の"2"）」を渡してやれば、現在のページのみPDF化できるということだ。

ちなみに、コーディングの際は、

こんなふうにインテリセンスが働くので、楽ちん。

ところで、列挙体だけど

WdExportRange.wdExportAllDocument

みたいに書かなくても良いのはなぜなんでしょうね？（←素人丸出しの疑問？）

ファイル名にページ番号を付加する

現在選択中のページのみをPDF化するのだから、できあがったPDFファイルのファイル名にページ番号を付加するぐらいの気は利かせたいところ。

となると、現在選択中のページのページ番号を取得しなければならない。

SelectionオブジェクトのInformationプロパティ

結論から言うと、SelectionオブジェクトのInformationプロパティを参照すれば良い。

このInformationプロパティには引数が何と

41種類

もあった。

そのうち、「wdActiveEndPageNumber」を渡すと、Informationプロパティは、現在カーソルのあるページのページ番号を返してくれる。

Selection.Information(wdActiveEndPageNumber)

こう書く。

ちなみに、「Selection.Information(」まで入力すると、

このようにインテリセンスが働くので、入力は簡単。

コーディング

以上のことを踏まえてコーディングしてみる。

リスト１　標準モジュール

Public Sub convertActivePageToPDF()
'///アクティブドキュメントをPDF化する。'
  Dim objDoc As Document
  Set objDoc = ActiveDocument
  Dim pathStr As String
  pathStr = objDoc.FullName
  Dim pageNum As Integer
  pageNum = Selection.Information(wdActiveEndPageNumber)    '……(1)'
  'フルパスから拡張子の「.」の位置を取得。'
  Dim n As Integer
  n = InStrRev(pathStr, ".")
  '「.」の位置を元に、PDFファイルのフルパスを作る。'
  'ページ番号３ケタゼロ埋め文字列をファイル名に付加する。'
  pathStr = Left(pathStr, n - 1) & _
            "_P." & Format(pageNum, "00#") & ".pdf"    '……(2)'
  With objDoc
    .ExportAsFixedFormat OutputFileName:=pathStr, _
                         ExportFormat:=wdExportFormatPDF, _
                         Range:=wdExportCurrentPage    '……(3)'
  End With
  Set objDoc = Nothing
End Sub

(1)の

pageNum = Selection.Information(wdActiveEndPageNumber)

では、SelectionオブジェクトのInformationプロパティに引数として「wdActiveEndPageNumber」を渡すことによって、現在カーソルのあるページの番号を取得し、変数pageNumに格納している。

(2)の

pathStr = Left(pathStr, n - 1) & _
          "_P." & Format(pageNum, "00#") & ".pdf"

について。

この行にたどり着いた段階で、変数 pathStr には編集中のドキュメントのフルパスが格納されており、変数 n には拡張子の「.」（ピリオド）の位置（前から何番目にあるか）が格納されている。

まず

Left(pathStr, n - 1) 

で、Left関数を用いて、フルパスのうち、拡張子の「.」（ピリオド）の左側の文字列を取得する。

次に

& "_P."

で文字列「_P.」を連結し、

さらに

Format(pageNum, "00#")

でFormat関数を用いてページ番号を３ケタ０埋めにした文字列を連結し、最後に「.pdf」を連結して、出力PDFファイルのファイルフルパスを作成している。1000ページを超すようなドキュメントを扱うことはまあないので３ケタにしているが、４ケタとか５ケタとか必要だったら、Format関数の第２引数を変えたら良いと思う。

(3)の

objDoc.ExportAsFixedFormat OutputFileName:=pathStr, _
                           ExportFormat:=wdExportFormatPDF, _
                           Range:=wdExportCurrentPage

で、ExportAsFixedFormatメソッドを実行する。引数「Range」に「wdExportCurrentPage」を指定しているので、現在カーソルのあるページだけがPDF化されることになる。

実行

実験用として、

こんなドキュメントを用意して、３ページ目にカーソルを置いて実行。

実に分かりにくいけど、３ページ目だけがPDF化された。

おわりに

現在のページのみPDF化する、という場面がそんなにあるかどうかは不明だけれど、そういう作業が頻繁に発生するようなら、アドインとして登録しておいたら便利だと思う。

アドイン登録の方法については、

akashi-keirin.hatenablog.com

コチラをどうぞ。

Word初心者なので、なかなかオブジェクト構造が飲み込みづらいけれど、分かってくると結構いじり甲斐がありそうな気もするなあ。

@akashi_keirin on Twitter

ユーザーフォームへのコントロール配置――ControlsコレクションのAddメソッド

ユーザーフォームへのコントロール配置――ControlsコレクションのAddメソッド

ControlsコレクションのAddメソッドによるコントロールの動的配置

この本の162ページによると、

ユーザーフォームにコントロールを追加するには、Controlsコレクション（集合体）のAddメソッドを使います。第１引数には、コントロールのクラス文字列を指定します。第２引数はコントロール名を指定します。

とのこと。ふむふむ、なるほど。

んで、

クラス文字列

については、同書184ページによると、

コントロール	クラス文字列
コマンドボタン	Forms.CommandButton.1
テキストボックス	Forms.TextBox.1
ラベル	Forms.Label.1
コンボボックス	Forms.ComboBox.1
リストボックス	Forms.ListBox.1
チェックボックス	Forms.CheckBox.1
オプションボタン	Forms.OptionButton.1
イメージ	Forms.Image.1
トグルボタン	Forms.ToggleButton.1
スクロールバー	Forms.ScrollBar.1
スピンボタン	Forms.SpinButton.1
タブストリップ	Forms.TabStrip.1
マルチページ	Forms.MultiPage.1

とのこと。（ふう。しっかしHTMLで表書くのしんどいな。）

つまり、

Dim ctrl As Control
Set ctrl = Controls.Add("Forms.CommandButton.1","BtnHogeHoge")

としてやれば、「BtnHogeHoge」という名前のCommandButtonコントロールを追加することができる、ということだ。

で、やってみた。

前回

akashi-keirin.hatenablog.com

のフォーム及びコードを流用する。

まずは、前回のリスト１の書き換えから。

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

Public Sub init_ver2(ByVal numOfBtns As Integer, _
                     ByVal btnHeight As Double, _
                     ByVal btnWidth As Double, _
                     ByVal offsetBtnsRow As Double, _
                     ByVal offsetBtnsCol As Double, _
                     ByVal numOfCols As Integer, _
                     ByVal btnName As String)
  numOfBtns_ = numOfBtns
  Dim i As Integer
  Dim ctrl As Control    '……(1)'
  For i = 1 To numOfBtns_
    Set ctrl = Controls.Add("Forms.CommandButton.1", _
                            "Btn" & Format(i, "0#"))    '……(2)'
    With ctrl
      .height = btnHeight
      .width = btnWidth
      .Top = offsetBtnsRow + ((offsetBtnsRow + btnHeight) * ((i - 1) \ numOfCols))
      .Left = offsetBtnsCol + ((offsetBtnsCol + btnWidth) * ((i - 1) Mod numOfCols))
      .Caption = btnName & StrConv(i, vbWide) & "号"
    End With
  Next
  With Me
    .height = offsetBtnsRow _
              + ((btnHeight + offsetBtnsRow) * (((numOfBtns_ - 1) \ numOfCols) + 1)) _
              + TOP_BOTTOM_MARGIN
    .width = offsetBtnsCol + ((btnWidth + offsetBtnsCol) * numOfCols) + offsetBtnsCol
  End With
End Sub

変えたのは(1)からの12行（実質11行）

Dim ctrl As Control
For i = 1 To numOfBtns_
  Set ctrl = Controls.Add("Forms.CommandButton.1", _
                          "Btn" & Format(i, "0#"))    '……(2)'
  With ctrl
    .height = btnHeight
    .width = btnWidth
    .Top = offsetBtnsRow + ((offsetBtnsRow + btnHeight) * ((i - 1) \ numOfCols))
    .Left = offsetBtnsCol + ((offsetBtnsCol + btnWidth) * ((i - 1) Mod numOfCols))
    .Caption = btnName & StrConv(i, vbWide) & "号"
  End With
Next

Control型の変数に、ControlsコレクションのAddメソッドを用いて、新しいボタンをセット。With以下のところは前回同様。Forループでボタンの数だけ繰り返している。

(2)の

Set ctrl = Controls.Add("Forms.CommandButton.1", _
                        "Btn" & Format(i, "0#"))

が今回の主役。

Addメソッドの第１引数に、コマンドボタンのクラス変数「Forms.CommandButton.1」を指定。最後の「1」まで必要なので注意。最初、オブジェクトの通し番号だと思って

Controls.Add("Forms.CommandButton." & i,"Btn" & Format(i, "0#"))

と書いて、i = 2 になったところでエラーが出たｗ

第２引数では、変数 i を用いて、名前が「Btn01」、「Btn02」、……となるようにした。

実行

ついでに実行方法も変更した。

ワークシート上に、こんなふうにボタンと表を作って、次のコードで実行するようにした。

リスト２　標準モジュール

Public Sub controlTest2()
  Dim testFrm As TestForm
  Set testFrm = New TestForm
  Dim num As Integer
  Dim str As String
  Dim height As Double
  Dim width As Double
  Dim frmName As String
  Dim numOfButtons As Integer
  With ActiveSheet    '……(1)'
    num = .Range("C2").Value
    str = .Range("C3").Value
    height = .Range("C4").Value
    width = .Range("C5").Value
    frmName = .Range("C6").Value
    numOfButtons = .Range("C7").Value
  End With
  If num = 0 Or num > 10 Then Exit Sub    '……(2)'
  If height < 10 Or height > 400 Then Exit Sub
  If width < 10 Or width > 400 Then Exit Sub
  If numOfButtons < 1 Or numOfButtons > 100 Then Exit Sub
  With testFrm
    .init_ver2 numOfBtns:=numOfButtons, _
               btnHeight:=height, _
               btnWidth:=width, _
               offsetBtnsRow:=10, _
               offsetBtnsCol:=5, _
               numOfCols:=num, _
               btnName:=str
    .Caption = frmName
    .Show
  End With
End Sub

(1)からの８行

With ActiveSheet
  num = .Range("C2").Value
  str = .Range("C3").Value
  height = .Range("C4").Value
  width = .Range("C5").Value
  frmName = .Range("C6").Value
  numOfButtons = .Range("C7").Value
End With

で、init_ver2メソッドに渡す引数のうち５つと、フォームのCaptionプロパティに渡す文字列をシートから取得する。

変数の名前を見てもらったら、どれが何に当たるかは分かると思う。

(2)からの４行

If num = 0 Or num > 10 Then Exit Sub
If height < 10 Or height > 400 Then Exit Sub
If width < 10 Or width > 400 Then Exit Sub
If numOfButtons < 1 Or numOfButtons > 100 Then Exit Sub

はガード節。不適切な値が設定されていたら処理をやめるようにしている。

ただし、条件設定はかなりテキトー。

実行結果

なんと、最初に設置した10個のコマンドボタンが設置されたまま、今回、Addメソッドで追加したコマンドボタンが上から配置されている……。

試しに、リスト１の最後に

For Each ctrl In Controls
  Debug.Print ctrl.name
Next

を追加して実行してみると、イミディエイト・ウインドウは、

こうなる。

どうやら、「Btn01」とか「Btn02」というのは「オブジェクト名」のことではないらしい。ま、当たり前か。

こんなふうに、もともと置いてあったコマンドボタンを全部削除してから実行すると、

無事、思い通りの結果が得られた。

おわりに

ついついムキになってユーザーフォーム・コントロール関係にハマってしまったが、実用的なものにするには、動的に配置したコントロールのイベントをどうするか、ということだと思う。ただ、ちょっとまだ今の私の力では手に負えない気もする。

まだまだ勉強が足りないね。

ユーザーフォームへのコントロール配置――このやり方があったじゃないか！

Controlsコレクションの引数

このやり方があったじゃないか！

前回

akashi-keirin.hatenablog.com

コチラの記事で、

オブジェクト名を「Object1」、「Object2」、……とかにしておいて、「Object & i」とかで指定できるか
ということなんだが、当然そんなことはできない。

などと、テキトーなことをぶっこいてしまったが、そんなことはない。

Controls("Object" & i)

という指定の仕方があったじゃないか！

コードの書き換え

というわけで、コードを修正。

前回記事のリスト１を次のように書き換える。

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

Public Sub init(ByVal btnHeight As Double, _
                ByVal btnWidth As Double, _
                ByVal offsetBtnsRow As Double, _
                ByVal offsetBtnsCol As Double, _
                ByVal numOfCols As Integer, _
                ByVal btnName As String)
  numOfBtns_ = 10
  Dim i As Integer
  For i = 1 To numOfBtns_
    With Controls("Btn" & Format(i, "0#"))
      .Height = btnHeight
      .Width = btnWidth
      .Top = offsetBtnsRow + ((offsetBtnsRow + btnHeight) * ((i - 1) \ numOfCols))
      .Left = offsetBtnsCol + ((offsetBtnsCol + btnWidth) * ((i - 1) Mod numOfCols))
      .Caption = btnName & StrConv(i, vbWide) & "号"
    End With
  Next
  With Me
    .Height = offsetBtnsRow _
              + ((btnHeight + offsetBtnsRow) * (((numOfBtns_ - 1) \ numOfCols) + 1)) _
              + TOP_BOTTOM_MARGIN
    .Width = offsetBtnsCol + ((btnWidth + offsetBtnsCol) * numOfCols) + offsetBtnsCol
  End With
End Sub

ちょっとスッキリした。

実行

次のコードで実行。

リスト２　標準モジュール

Public Sub controlTest()
  Dim testFrm As TestForm
  Set testFrm = New TestForm
  With testFrm
    .init btnHeight:=20, _
          btnWidth:=50, _
          offsetBtnsRow:=10, _
          offsetBtnsCol:=5, _
          numOfCols:=5, _
          btnName:="クズ"
    .Caption = "ち～んｗ"
    .Show
  End With
End Sub

第６引数だけちょっと変えてみたｗ

実行結果

うまくいった。

おわりに

同じ種類のコントロールを規則正しく配置するだけならこのやり方が一番いいかも。

ただ、実用的なものにするには当然イベント処理を追加していく必要があるわけで、そういうところも工夫する必要がありそうだ。

@akashi_keirin on Twitter

ユーザーフォームへのコントロール配置の効率化に挑む

コントロールの配置の効率化

コントロールを規則的に配置する

前回、

akashi-keirin.hatenablog.com

は、コントロールを配列にぶち込んでまとめて処理、という方法を試みた。

配列にぶち込みさえすれば、後はループを回すだけなのだが、そもそも配列にぶち込む段階で、

Dim btns(2) As CommandButton
Set btns(0) = Me.BtnLeft
Set btns(1) = Me.BtnCenter
Set btns(2) = Me.BtnRight

こんな書き方をするなんて、エレガントさのかけらもない。もっと言えば、ダサい。

かと言って、Array関数を使っても、

Dim btns As Variant
btns = Array(Me.BtnLeft, Me.BtnCenter, Me.BtnRight)

になるだけなので、ダサいことには違いない。

オブジェクト名を変数で合成して呼び出せるか

分かりにくい見出しだが、要するに、

オブジェクト名を「Object1」、「Object2」、……とかにしておいて、「Object & i」とかで指定できるか

ということなんだが、当然そんなことはできない。

For Each を使えばいいんじゃね？

オブジェクト名は、Control型オブジェクトのNameプロパティで取得できるから、For Each XX In Controlsで全てのコントロールをループして、オブジェクト名が条件に合うときだけ処理したら良いと考えた。

準備

ユーザーフォームを挿入して、オブジェクト名を「TestForm」にし、コマンドボタンを10個配置した。画面では整然と並べているけれども、別にグチャグチャに並べておいても良い。

それぞれのコマンドボタンには、「Btn01」～「Btn10」と通し番号付きのオブジェクト名を付けておく。めんどくさいけど。

あとは、コーディング。

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

Option Explicit

Private numOfBtns_ As Integer

Public Sub init(ByVal btnHeight As Double, _
                ByVal btnWidth As Double, _
                ByVal offsetBtnsRow As Double, _
                ByVal offsetBtnsCol As Double, _
                ByVal numOfCols As Integer, _
                ByVal btnName As String)    '……(*)'
  Dim ctrl As Control
  Dim i As Integer
  numOfBtns_ = 0
  For Each ctrl In Controls    '……(1)'
    If Left(ctrl.name, 3) = "Btn" Then    '……(2)'
      numOfBtns_ = numOfBtns_ + 1
      With ctrl    '……(3)'
        .Height = btnHeight
        .Width = btnWidth
        i = numOfBtns_
        .Top = offsetBtnsRow + ((offsetBtnsRow + btnHeight) * ((i - 1) \ numOfCols))
        .Left = offsetBtnsCol + ((offsetBtnsCol + btnWidth) * ((i - 1) Mod numOfCols))
        .Caption = btnName & StrConv(i, vbWide) & "号"
      End With
    End If
  Next
  With Me    '……(4)'
    .Height = offsetBtnsRow _
              + ((btnHeight + offsetBtnsRow) * (((numOfBtns_ - 1) \ numOfCols) + 1)) _
              + TOP_BOTTOM_MARGIN
    .Width = offsetBtnsCol + (btnWidth + offsetBtnsCol) * numOfCols + offsetBtnsCol
  End With
End Sub

まずは(*)のところ。まさに引数祭りｗｗｗ

ByVal btnHeight As Double, _
ByVal btnWidth As Double, _
ByVal offsetBtnsRow As Double, _
ByVal offsetBtnsCol As Double, _
ByVal numOfCols As Integer, _
ByVal btnName As String

上から順に、

• btnHeight――ボタンの高さ
• btnWidth――ボタンの幅
• offsetBtnsRow――タテ方向のボタンとボタンの間隔
• offsetBtnsCol――ヨコ方向のボタンとボタンの間隔
• numOfCols――１行あたりのボタンの数
• btnName――ボタンの名前

とまあ、これだけの引数を渡して初期化することにしている。

(1)の

For Each ctrl In Controls

からNextまでのブロックで、フォーム内の全コントロールをループ。

(2)の

If Left(ctrl.name, 3) = "Btn" Then

でコントロールのオブジェクト名を調べる。今回配置したコマンドボタンは、全て最初の３字が「Btn」となっているので、この条件がTrueになるということは、Control型変数ctrlにコマンドボタンがぶち込まれているということ。

(3)からの８行

 With ctrl
  .Height = btnHeight
  .Width = btnWidth
  i = numOfBtns_
  .Top = offsetBtnsRow + ((offsetBtnsRow + btnHeight) * ((i - 1) \ numOfCols))
  .Left = offsetBtnsCol + ((offsetBtnsCol + btnWidth) * ((i - 1) Mod numOfCols))
  .Caption = btnName & StrConv(i, vbWide) & "号"
End With

は、ボタンに対する処理。

Top及びLeftプロパティでは、一見ややこしそうな計算をしているようだが、中身は実に単純。図を書いてみたら良いと思う。説明はめんどくさいので省略。

(4)からの６行（実際は４行）

With Me
  .Height = offsetBtnsRow _
            + ((btnHeight + offsetBtnsRow) * (((numOfBtns_ - 1) \ numOfCols) + 1)) _
            + TOP_BOTTOM_MARGIN
  .Width = offsetBtnsCol + (btnWidth + offsetBtnsCol) * numOfCols + offsetBtnsCol
End With

は、フォーム本体の設定。

高さ、幅ともに、
[上下 or 左右の余白]プラス
（[ボタンの高さ or 幅]＋[ボタン間の隙間の寸法]）×[行数 or 列数]
で良いはずなんだが、その通りに式を書くと、

このような残念な形になってしまう。

よって、定数TOP_BOTTOM_MARGIN（中身は「20」）をプラスすることにしている。

実行

次のコードで実行する。

リスト２　標準モジュール

Public Sub controlTest()
  Dim testFrm As TestForm
  Set testFrm = New TestForm
  With testFrm
    .init btnHeight:=20, _
          btnWidth:=50, _
          offsetBtnsRow:=10, _
          offsetBtnsCol:=5, _
          numOfCols:=5, _
          btnName:="アホ"
    .Caption = "ち～んｗ"
    .Show
  End With
End Sub

コードについては特に説明はいらないと思う。

実行結果

ボタンが美しく整列している。

おわりに

ただ、このやり方でも、そもそも各コマンドボタンにオブジェクト名をポチポチ書いていかないといけないのはメンドクサイ。配置するコントロールの数を指定して、一気に大量のコントロールを配置する方法もあるんだろうなあ……。

やっぱり、現状では何かの役には立ちそうもないねえ。

@akashi_keirin on Twitter

ユーザーフォームへのコントロール配置を効率的に行う？

ユーザーフォームを効率的に作る

コントロールはNewできるか

やってみた。

なお、ユーザーフォームは、

akashi-keirin.hatenablog.com

このときのものを使う。

オブジェクト名が「BtnLeft」なので、BtnLeft型の変数が宣言できると思ったが、

あえなく撃沈ｗ　Newする以前の問題ｗｗｗ

コントロールをNewして量産し、フォーム上に動的に配置していく、ということはできない模様。

コントロールをまとめて扱う

ならば、複数のコントロールを配列にぶち込んで、まとめて設定できないか、やってみた。

CommandButton型の変数が宣言できるので、

Dim btns(2) As CommandButton
Set btns(0) = Me.BtnLeft
Set btns(1) = Me.BtnCenter
Set btns(2) = Me.BtnRight

みたいにしたらぶち込めるんじゃないかと思ってやってみたら、

おお、無事通過！　できたみたい。

ということは、まとめて取り扱えるということか。

各コマンドボタンのプロパティをまとめて設定する

無事に３つのコマンドボタンを配列にぶち込むことができたので、Forループを使えば、規則的にプロパティを設定できるはず。

次のようなコードで設定を試みた。

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

Public Sub init(ByVal formCaption As String, _
                ByVal btnLeftName As String, _
                ByVal btnCenterName As String, _
                ByVal btnRightName As String)
  With Me
    .Caption = formCaption
    .BtnLeft.Caption = btnLeftName
    .BtnCenter.Caption = btnCenterName
    .BtnRight.Caption = btnRightName
  End With
  Dim btns(2) As CommandButton
  Set btns(0) = Me.BtnLeft
  Set btns(1) = Me.BtnCenter
  Set btns(2) = Me.BtnRight
  Dim i As Integer
  For i = 0 To 2
    With btns(i)    '……(1)'
      .Height = 25    '……(2)'
      .Width = 90
      .Top = 10    '……(3)'
      .Left = 5 + ((90 + 5) * i)
    End With
  Next
  Me.Height = 65    '……(4)'
  Me.Width = 295
End Sub

Private Sub UserForm_Terminate()_    '……(5)'
  MsgBox Me.secretName
End Sub

このユーザーフォームの擬似コンストラクタ。引数を渡したいので、UserForm_Initializeは使わない。

(1)からの６行

With btns(i)
  .Height = 25
  .Width = 90
  .Top = 10
  .Left = 5 + ((90 + 5) * i)
End With

は全てWithでまとめているので、配列btnsにぶち込んだそれぞれのコマンドボタンに対する処理。

(2)からの２行

.Height = 25
.Width = 90

でボタンの大きさを設定し、

(3)からの２行

.Top = 10
.Left = 5 + ((90 + 5) * i)

でフォーム上の位置を設定。

Topプロパティは固定で良いが、Leftプロパティはボタンの横幅とボタン同士の間隔分だけ右へずらしていかないといけないので、こんなふうに設定している。まあ、中学校レベルの数学ですわな。

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

Me.Height = 65
Me.Width = 295

でフォーム全体の大きさを設定しておしまい。

あと、ユーザーフォーム終了時に、追加したプロパティ「secretName」をメッセージ表示するように、(5)の

Private Sub UserForm_Terminate()
  MsgBox Me.secretName
End Sub

デストラクタを作った。

実行

次のコードで実行。

リスト２　標準モジュール

Option Explicit

Public Sub userFormTest()
  Dim uFrm As UserFormTemplate
  Set uFrm = New UserFormTemplate
  With uFrm
    .init "アホ", "ボケ", "クズ", "デコスケ"
    .secretName = "ち～んｗ"
    .Show
  End With
End Sub

これは、このときとほとんど同じ。追加プロパティ「secretName」をイミディエイトに表示する代わりに、ユーザーフォーム終了時のメッセージ表示にした関係でDebug.Printがなくなっただけ。

実行結果

おおっ、ボタンが整然と配置されておる！

で、フォームを閉じると、

むかつくｗｗｗ

おわりに

未だに便利な使いどころは思いつかないけれど、何らかの有効な使い道はある……はず……だよね？（弱気）

@akashi_keirin on Twitter