「フォームコントロールのボタンオブジェクトのEnabledプロパティって、意味ないんじゃね?」問題

「フォームコントロールのボタンオブジェクトのEnabledプロパティって、意味ないんじゃね?」問題

前回

akashi-keirin.hatenablog.com

の続き。

ボタンのEnabledプロパティをFalseにしてみる

イミディエイト・ウインドウに

activesheet.buttons(1).enabled = false

と打ち込んで、[Enter]をビシッ!

f:id:akashi_keirin:20180924182441j:plain

この画像では何のことか分からんが、イミディエイト・ウインドウに

?activesheet.buttons(1).enabled

と打ち込んで、[Enter]をペチッ!

f:id:akashi_keirin:20180924182449j:plain

このように、ボタンオブジェクトのEnabledプロパティの値がFalseになっていることが分かる。

ボタンはどうなっているか

EnabledプロパティがFalseである以上、ボタンは無効化されていると考えるのが通常だろう。そこで、

f:id:akashi_keirin:20180924182459j:plain

この状態でクリック。

ボタンにはこちらのマクロが仕込まれています。

f:id:akashi_keirin:20180924182507j:plain

フツーにボタンは生きとるじゃん。

おわりに

Enabledプロパティって、何か意味あるのでしょうか?

フォームコントロールのボタンオブジェクトをVBAで捕まえる

フォームコントロールのボタンを捕まえる

マクロを呼び出すためのボタンをシート上に設置することがよくある。

シート上に設置したボタンをVBAで取得するにはどうすればよいのだろうか。

Nameプロパティを取得してみる

ボタンの上で右クリックすると、

f:id:akashi_keirin:20180924180908j:plain

このように、ボタンを選択した状態になる。

この状態で、イミディエイト・ウインドウに

?selection.name

と打ち込んで、[Enter]をバシッ!

f:id:akashi_keirin:20180924180800j:plain

このように、「Button 1」と出た。

何オブジェクトなのかは分からんが、Nameプロパティを持っており、パラメータが「Button 1」であることが分かった。

何型のオブジェクトなのか

今度は、TypeName関数を使ってみる。

同じくボタンが選択された状態で、イミディエイト・ウインドウに

?typename(selection)

と打ち込んで、[Enter]をバチコーン!

f:id:akashi_keirin:20180924180920j:plain

ご覧のように「Button」と出た。

親オブジェクトは何なのか

さらに、イミディエイト・ウインドウに

?typename(selection.parent)

と打ち込んで、[Enter]をドオォーーーン!

f:id:akashi_keirin:20180924180935j:plain

今度は、「Worksheet」が返った。

フォームコントロールのボタンオブジェクトを取得する

上の実験により、フォームコントロールのボタンオブジェクトは、

  • Worksheetオブジェクトの配下である
  • Button型のオブジェクトである
  • Nameプロパティを持つ



ということが分かった。

以上のことを念頭に、コーディングしてみる。

すると……、

f:id:akashi_keirin:20180924180955j:plain

なにーーーーっ!

入力候補に「Button」がねえ!

しかし、それでもめげずにコーディングしてみた。

リスト1 標準モジュール
Public Sub testCommandButton()
  Dim btn As Button
  Set btn = ActiveSheet.Buttons(1)    '……(1)'
  btn.Caption = ActiveSheet.Range("A1").Value    '……(2)'
End Sub

(1)の

Set btn = ActiveSheet.Buttons(1)

Button型の変数「btn」にボタンオブジェクトをセット。

Button型」というぐらいだから、「Buttons」コレクションの要素のはず。

んで、ActiveSheetにはボタンは一つしかないのだから、Buttons(1)で良いはず。

あとは、

f:id:akashi_keirin:20180924181005j:plain

コーディング中に、このように入力候補が出るぐらいだから「Caption」プロパティがあるはず。ゆえに、(2)の

btn.Caption = ActiveSheet.Range("A1").Value

で、ボタンのテキストをA1セルの文字列にする。

実行

リスト1testCommandButtonをボタンに登録して、

f:id:akashi_keirin:20180924181014j:plain

この状態でクリック。

f:id:akashi_keirin:20180924181023j:plain

無事にボタンのテキストが書き換わった。

おわりに

Buttonオブジェクトの構造については、オブジェクト・ブラウザーにも出てこないので、ちょっとわかりにくい。

infoment.hatenablog.com

こちらの記事にインスパイヤされて書きました。

続編

akashi-keirin.hatenablog.com

クラスのPrivateメソッドもイミディエイトで実行できる

クラスのPrivateメソッドもイミディエイトで実行できる

再び超小ネタ。

クラスモジュールの準備

クラスモジュールを作る。

リスト1 クラスモジュール
'オブジェクト名は"HiddenBooks"'
Private Function isHiddenBook( _
                   ByVal targetBook As Workbook) As Boolean
  isHiddenBook = True
  If targetBook.IsAddin Then Exit Function
  Dim i As Long
  For i = 1 To targetBook.Windows.Count
    If targetBook.Windows(i).Visible Then _
      isHiddenBook = False: Exit Function
  Next
End Function

isHiddenBookというメソッドを1つ書いただけ。

PredeclaredIdをTrueにする

イミディエイトで実行することを考えて、PredeclaredIdTrueにする。

一旦、クラスモジュールHiddenBooksをエクスポートして、エディタで開く。

んで、上の方を

f:id:akashi_keirin:20180922124937j:plain

こんなふうにする(8行目です。)。

デフォルトでは、

Attribute VB_PredeclaredId = False

になっているので、「False」を「True」に書き換えて保存、再びインポートするだけ。

これで、インスタンス化しなくても[クラス名].[メソッド・プロパティ名]でメソッドやプロパティにアクセスできる。

実験

イミディエイト・ウインドウに

?HiddenBook.isHiddenBook(Workbooks("PERSONAL.XLSB"))

と入力して[Enter]をぶっ叩くと、

f:id:akashi_keirin:20180922124947j:plain

このように、意図どおりの結果が出る。

「だから何?」と言われても、特に意見はありません。

ちなみに

クラス外から呼ぶのは

f:id:akashi_keirin:20180922130152j:plain

当然不可能ですw

個人用マクロブックはアドインに非ず

個人用マクロブックはアドインに非ず

「当り前だろバカ!」と思ったらスルー推奨。

IsAddinプロパティ

イミディエイト・ウインドウに

?Workbooks("PERSONAL.XLSB").IsAddin

と打ち込んで[Enter]をポチッ。すると、

f:id:akashi_keirin:20180922123534j:plain

Falseが返るのであった。

Windows.Countプロパティ

ちなみに、

?Workbooks("PERSONAL.XLSB").Windows.Count

だと、

f:id:akashi_keirin:20180922123543j:plain

このように、「1」が返る。

[Window].Visibleプロパティ

またまたちなみに、

?Workbooks("PERSONAL.XLSB").Windows(1).Visible

だと、

f:id:akashi_keirin:20180922123551j:plain

このように、「False」が返る。

おわりに

つまり、Workbooksコレクションのメンバが「PERSONAL.XLSB」かどうかは、WorkbookオブジェクトのNameプロパティで確認するのが一番簡単かつ確実ということになるのかなあ。

非表示ブックの数を返すFunction(Excel)

非表示Bookの数を返すFunction

アドインとか、個人用マクロブックみたいな、ブックを開いたら裏で勝手に開いているブックの数と、オモテで正々堂々と開いているブックの数を別々に取得する必要があったので作ってみた。

考えかた

Application.WorkbooksコレクションのCountプロパティは、表示/非表示に関係なく、開いているブック全ての数を返すっぽいので、Workbooksコレクションの要素ひとつひとつを調べるしかないと思った。

非表示ブックの拡張子は、たぶん「xlsb」、「xlt」、「xltm」、「xla」、「xlam」の5つっぽいので、拡張子で判定できると思った。(実は「テンプレートファイル」ってのが何のことだか分かっていないので、「xlt」と「xltm」は入れておくべきなのかどうなのか分かっていない。←調べろよ!)

コード

リスト1 標準モジュール
Public Function getHiddenBooksCount( _
                   ByVal excelApp As Excel.Application) As Long
  Dim ret As Long
  ret = 0
  Dim Wb As Workbook
  For Each Wb In excelApp.Workbooks
    If isHiddenBook(getExtentionString(Wb.Name)) Then _
      ret = ret + 1
  Next
  getHiddenBooksCount = ret
End Function

Private Function getExtentionString( _
                   ByVal targetFileName As String) As String
  Dim positionOfDot As Long
  positionOfDot = InStrRev(targetFileName, ".")
  Dim ret As String
  ret = Right(targetFileName, Len(targetFileName) - positionOfDot)
  getExtentionString = ret
End Function
                   
Private Function isHiddenBook( _
                   ByVal targetExtention As String) As Boolean
  isHiddenBook = True
  Dim ar As Variant
  ar = Split("xlsb xlt xltm xla xlam")
  Dim i As Long
  For i = LBound(ar) To UBound(ar)
    If StrConv(ar(i), vbLowerCase) = _
       StrConv(targetExtention, vbLowerCase) Then _
      Exit Function    '……(*)'
  Next
  isHiddenBook = False
End Function

メインのgetHiddenBooksCountから、getExtentionStringisHiddenBookを呼び出して、非表示ブックの数をカウントしている。

isHiddenBookの(*)のところでStrConv関数を用いているのがミソ。

単純に素の拡張子文字列で比較しようとすると、getExtentionStringで取得した拡張子が大文字だったら一致したと見なされないのである。

たとえば、個人用マクロブックの拡張子は「XLSB」だった。

使ってみた

プロジェクトエクスプローラーは

f:id:akashi_keirin:20180920210506j:plain

この状態。

で、イミディエイト・ウインドウに
?getHiddenBooksCount(Application)
と入力して[Enter]をポチッ。

f:id:akashi_keirin:20180920210516j:plain

とりあえず意図どおりの結果が出た。

おわりに

テストが不十分なので、これで良いのかどうかはよく分かっていない。

追記

id:imihito さんからコメントをいただいたので、それを参考に修正。

id:imihito さんによると、

ブックが非表示になるのは `Workbook.IsAddin`がTrueのとき、
そして`Window.Visible`がFalseのとき

との由。

つまり、上記リスト1isHiddenBookメソッドを、

WorkbookオブジェクトのIsAddinプロパティがTrue

または

Workbookオブジェクトの全ての[Window].VisibleプロパティがFalse

だったらTrueを返すようなものにすればよい。

スト2 標準モジュール
Private Function isHiddenBook( _
                   ByVal targetBook As Workbook) As Boolean    '……(1)'
  isHiddenBook = True    '……(2)'
  If targetBook.IsAddin Then Exit Function
  Dim i As Long
  For i = 1 To targetBook.Windows.Count    '……(3)'
    If targetBook.Windows(i).Visible Then _
      isHiddenBook = False: Exit Function
  Next
End Function

(1)の

Private Function isHiddenBook( _
                   ByVal targetBook As Workbook) As Boolea

もはや、引数からして変えた。別に拡張子で判定する必要はないし、ExcelVBAer (id:x1xy2xyz3) さんからいただいたコメントからしても、「.xlsb」のブックを非表示ブックとカウントしてしまうのはまずい。

よって、Workbookオブジェクトを引数として受け取るようにした。

(2)からの2行

isHiddenBook = True
If targetBook.IsAddin Then Exit Function

では、最初に返り値をTrueにしておき、IsAddinプロパティだったら即returnするようにした。

ここを通過すると、アドインではないことになるので、後はWorkbookオブジェクトが持つ全てのWindowオブジェクトを調べる段階へ進む。

(3)から4行(実質3行)がそれ。

For i = 1 To targetBook.Windows.Count
  If targetBook.Windows(i).Visible Then _
       isHiddenBook = False: Exit Function
Next

WindowオブジェクトのVisibleプロパティに1つでもTrueのものがあったら、即Falseをreturn、という仕組み。

再び、おわりに

これによって、getExtentionStringメソッドは用なし芳一と相成りました。

Split関数の裏技

Split関数の裏技

このとき、

akashi-keirin.hatenablog.com

thom (id:t-hom) さんに教えてもらった。

Split関数の第2引数は省略できる

完全に思い込みで必須だと思っていた。

なるほど、Office VBA Reference の Split Function の項によると、

Syntax
Split( expression [ , delimiter [ , limit [ , compare ]]] ) 
The Split function syntax has these named arguments:
Part Description
delimiter Optional. String character used to identify substring limits. If omitted, the space character (" ") is assumed to be the delimiter. If delimiter is a zero-length string, a single-element array containing the entire expression string is returned.
以下略 以下略

確かに、第2引数delimiterOptional、つまり省略可能で、省略された時は「the space character (" ")」と見なされるみたいなことが書いてある。

サンプルコード

次のコードで実験。

リスト1 標準モジュール
Public Sub testSplitFunction()
  Dim ar As Variant
  ar = Split("お ま え は ア ホ か")    '……(1)'
  Dim i As Long
  For i = LBound(ar) To UBound(ar)    '……(2)'
    Debug.Print ar(i)
  Next
End Sub

(1)の

ar = Split("お ま え は ア ホ か")

では、Split関数に文字列「お ま え は ア ホ か」だけを渡している。わかりにくいけれど、各文字の間を半角スペースで区切っている。

第2引数を省略しているので、delimiterに半角スペースを指定していると見なされ、「お」「ま」「え」「は」「ア」「ホ」「か」を要素とする配列が変数arに格納されるはずだ。

あとは、(2)からの3行

For i = LBound(ar) To UBound(ar)
  Debug.Print ar(i)
Next

で、配列の各要素をイミディエイト・ウインドウに表示する。

実行

f:id:akashi_keirin:20180914183846j:plain

このとおり。

おわりに

非常に便利なテクニックだと思います。

セル範囲が格子状になっているか判定するFunction(Excel)

セル範囲が格子状になっているか判定するFunction

いわゆる「Excel方眼紙」との戦いの一環。

セル結合とかガンガンズンズングイグイかまして作った表が、格子状になっているか判定する必要に迫られたのだった。

かつて誰かが作ったツールに不具合があって、変なエラーが出る、と報告を受けたので、ちょっと修正してみようと思ったら、すっげーアクロバチックなコードで実装されていてびっくり仰天したのであった。

んで、やってみたら、負けず劣らずアクロバチックなコードになったという……。

一つの道しるべとして残しておく。

考えかた

とりあえず、RangeオブジェクトのMergeAreaプロパティを使えば、結合されているセルのTopLeftの位置が取得できる([Range].MergeArea(1, 1)でTopLeftのセルが返る)ので、これを利用しようと考えた。

たとえば、セル範囲の1行目について、一つづつヨコ方向に進んで、TopLeftセルの列番号が変わるごとに配列にぶち込んでいく。

2行目以降も、同じように一つづつヨコ方向に進み、同じくTopLeftセルの列番号が変わるごとに配列にぶち込んでいく。

一つ目の配列と二つ目の配列を比較して、要素が異なっていたら、格子状になっていないということなのでFalseを返す。

一つ目の配列と二つ目の配列が全く同じだったら、次の行に進む。

最後の行まで完走しても、全て二つの配列が全く同じだったら、Trueを返す。

タテ方向についても同じように調べる。

ヨコ・タテ両方ともTrueが返るなら、そのセル範囲は格子状になっている、ということなので、Trueを返す。

このような考えかたでコーディングしてみた。

列方向の区切り位置を調べるFunction

リスト1 標準モジュール
Private Function isHorisontalRegulated( _
	ByVal targetRange As Range) As Boolean
  isHorisontalRegulated = False    '……(1)'
  Dim criterionArray() As Long    '……(2)'
  ReDim criterionArray(0)
  criterionArray(0) = targetRange.Cells(1, 1).MergeArea(1, 1).Column
  Dim n As Long
  n = 0
  Dim j As Long
  For j = 2 To targetRange.Columns.Count
    With targetRange.Cells(1, j).MergeArea(1, 1)
      If .Column <> criterionArray(n) Then
        n = n + 1
        ReDim Preserve criterionArray(n)
        criterionArray(n) = .Column
      End If
    End With
  Next
  Dim compareArray() As Long    '……(3)'
  ReDim compareArray(0)
  Dim i As Long
  For i = 2 To targetRange.Rows.Count
    compareArray(0) = targetRange.Cells(i, 1).MergeArea(1, 1).Column
    n = 0
    For j = 1 To targetRange.Columns.Count
      With targetRange.Cells(i, j).MergeArea(1, 1)
        If .Column <> compareArray(n) Then
          n = n + 1
          ReDim Preserve compareArray(n)
          compareArray(n) = .Column
        End If
      End With
    Next
    If Not isTheSame(criterionArray, compareArray) _
      Then Exit Function    '……(4)'
  Next
  isHorisontalRegulated = True    '……(6)'
End Function

Private Function isTheSame( _
		ByRef criterionArray() As Long, _
        ByRef compareArray() As Long) As Boolean    '……(5)'
  isTheSame = False
  If UBound(criterionArray()) <> UBound(compareArray()) Then Exit Function
  If LBound(criterionArray()) <> LBound(compareArray()) Then Exit Function
  Dim i As Long
  For i = LBound(criterionArray()) To UBound(criterionArray())
    If criterionArray(i) <> compareArray(i) Then Exit Function
  Next
  isTheSame = True
End Function

まず、(1)の

isHorisontalRegulated = False

でデフォルト値を明示。別に無くてもよいのだけれど、明示しておくことに意義があると思う。

このFunctionの場合、一つでも不正な区切りが見つかったらその時点でFalse確定なので、Falseをデフォルト値にする。即returnでFalseが返ることになる。

(2)からの15行

Dim criterionArray() As Long
ReDim criterionArray(0)
criterionArray(0) = targetRange.Cells(1, 1).MergeArea(1, 1).Column
Dim n As Long
n = 0
Dim j As Long
For j = 2 To targetRange.Columns.Count
  With targetRange.Cells(1, j).MergeArea(1, 1)
    If .Column <> criterionArray(n) Then
      n = n + 1
      ReDim Preserve criterionArray(n)
      criterionArray(n) = .Column
    End If
  End With
Next

で、対象のセル範囲の1行目をスキャンし、列区切り位置の配列criterionArrayを作る。

たとえば、

f:id:akashi_keirin:20180908234952j:plain

このようなセル範囲だったら、[1, 3, 5, 8, 10]という配列ができることになる。

(3)からの18行(実質17行)

Dim compareArray() As Long
ReDim compareArray(0)
Dim i As Long
For i = 2 To targetRange.Rows.Count
  compareArray(0) = targetRange.Cells(i, 1).MergeArea(1, 1).Column
  n = 0
  For j = 1 To targetRange.Columns.Count
    With targetRange.Cells(i, j).MergeArea(1, 1)
      If .Column <> compareArray(n) Then
        n = n + 1
        ReDim Preserve compareArray(n)
        compareArray(n) = .Column
      End If
    End With
  Next
  If Not isTheSame(criterionArray, compareArray) _
    Then Exit Function    '……(4)'
Next

では、criterionArrayを作ったときと同じやり方で配列compareArrayを作成する。

ただし、1行スキャンするごとに(4)の

If Not isTheSame(criterionArray, compareArray) Then Exit Function

(5)のisTheSameを呼び出して、二つの配列「criterionArray」と「compareArray」を比較。少しでも異なっていたら、即Falseを返すようにしている。

スト2 標準モジュール
Private Function isVerticalRegulated(ByVal targetRange As Range) As Boolean
  isVerticalRegulated = False
  Dim criterionArray() As Long
  ReDim criterionArray(0)
  criterionArray(0) = targetRange.Cells(1, 1).MergeArea(1, 1).Row
  Dim n As Long
  n = 0
  Dim i As Long
  For i = 2 To targetRange.Rows.Count
    With targetRange.Cells(i, 1).MergeArea(1, 1)
      If .Row <> criterionArray(n) Then
        n = n + 1
        ReDim Preserve criterionArray(n)
        criterionArray(n) = .Row
      End If
    End With
  Next
  Dim compareArray() As Long
  ReDim compareArray(0)
  Dim j As Long
  For j = 2 To targetRange.Columns.Count
    compareArray(0) = targetRange.Cells(1, j).MergeArea(1, 1).Row
    n = 0
    For i = 1 To targetRange.Rows.Count
      With targetRange.Cells(i, j).MergeArea(1, 1)
        If .Row <> compareArray(n) Then
          n = n + 1
          ReDim Preserve compareArray(n)
          compareArray(n) = .Row
        End If
      End With
    Next
    If Not isTheSame(criterionArray, compareArray) Then Exit Function
  Next
  isVerticalRegulated = True
End Function

コチラは、全く同じ考えかたで、タテ方向にスキャン。

ほとんど同じコードを二つも並べる、というのはうまくないけれど、とりあえず対策が思い浮かばない。

上記の二つのFunctionがともにTrueを返せば、対象のセル範囲は格子状になっている、ということになる(と思う……)。

リスト3 標準モジュール
Public Function isGridShape(ByVal targetRange As Range) As Boolean
  isGridShape = True
  If isHorisontalRegulated(targetRange) And _
     isVerticalRegulated(targetRange) Then Exit Function
  isGridShape = False
End Function

使ってみる

まず、

f:id:akashi_keirin:20180908235003j:plain

この状態で、イミディエイト・ウインドウに

?isGridShape(Selection)

と打ち込んでみる。

f:id:akashi_keirin:20180908235017j:plain

意図どおり、Falseが返った。

f:id:akashi_keirin:20180908235024j:plain

この状態で実行しても、

f:id:akashi_keirin:20180908235035j:plain

やはりFalseが返る。意図どおり。

f:id:akashi_keirin:20180908235042j:plain

この状態で実行すると、

f:id:akashi_keirin:20180908235050j:plain

今度はTrueが返った。意図どおりだ。

おわりに

Excel方眼紙が横行している現場は大変です。