ユーザーフォーム幅をマウスで調整する　について検討

はじめに

たいしたことではないんですが、ユーザーフォーム作ってて、データの横幅がテキストボックスやリストボックスから溢れちゃって、見ずらい(てゆーか隠れて見えない)こと。
よくありますよね。

シート上のリストだったら、その列の書式設定を表示するコントロールのFont条件に近い設定にしてAutoFitかけて列幅をいただいて・・・・なんて。
涙ぐましい努力を強いられたりしますが、コントロールの表示幅をユーザーがマウスで調整できれば、｢勝手にやって頂戴｣なんて言える訳で。

実は、今までにもチョコチョコとお試しを入れたりしてたんですが、一回きちんとやってみようか　と思い立ったもんで　皆様の参考になりましたら。
相変わらず前置きが長くてごめんなさい。　ではでは

サンプルファイルダウンロード

WidthMouse.xls 55KB

基本構造

細かい説明はほぼ省きます。（おいおい）
要は、マウスのクリック位置を拾って、横に移動を検知したら該当するコントロールの位置や幅を調整することです。

欲しい情報	イベント	動　　　作
マウスのクリック位置	MouseDwonイベント	フォーム上の部品やPublic変数に記録したいところです ここでは、フォームのタグを利用します （宣言・部品配置等の手間が不要なので）
マウスの移動	MouseMoveイベント	幅調整と移動するコントロールを指定してマウス移動分調整をかける

移植手順

ユーザーフォーム上	●フォームの要所にMouseMoveを受け入れるラベルを配置します。 　　BackStyleを0(透明)にし、MousePointerを9(SizeEW)に設定します。 　　ここでは、NameをLaW,LaW1などとしていますが、自由につけていただいてかまいません。 　　幅調整と移動するコントロールは引数として名前を渡すので、短い方がいいかと。 　　リストボックスの前面にラベルは配置できないので、タイトルラベルの境目で幅を表現します。 ●マウスの位置(ｘ）はユーザーフォームのタグに記録します。(ここでは何もしません) ●「マウスによりリスト幅やフォーム幅が変更可能です」などとラベルで書いておかないと 　　誰も気がつかない！！可能性があります。
フォームモジュール	'呼出側コントロールの数だけ以下のようにイベントプロシージャを配置します。 '以下の例はフォーム全体幅の調整、幅調整コントロールなし、位置調整コントロールが「LaW, Label1, LaX」の3個 'リスト幅調整(オプション)はなし。　との設定になります。 Private Sub LaW_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _ 　　　　　　　　　　　　　　　　　　　　　　　ByVal x As Single, ByVal Y As Single): Me.Tag = x: End Sub Private Sub LaW_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _ 　　　　　　　　　　　　　　　　　　　　　　　ByVal x As Single, ByVal Y As Single) If Button = 1 Then MoveWidth Me, TRUE, x, 0, Array(LaW, Label1, LaX) End Sub　　　　　　　　　'横移動関数　幅変更コントロール,横位置変更コントロール,リストコントロール,列番号 '　赤字部分を実際の呼出コントロール名に書き換える '　青字部分は、位置、幅調整コントロールを引数として記入しますので、適宜 書き換えが必要です。 '　MoveW、MoveLは配列でコントロールを受け取るので、1個だけの場合は　Array(LaW)　と表現します。
標準モジュール 実際の移植作業	「MoveWidth」モジュールをプロジェクトエクスプローラー上でサンプルブックからコピーします。 左ドラッグで下の移植先ブックへ持ってゆき、ドロップするとコピーされます。 テストフォーム表示プロシージャ Sub Show_Test() UserForm1.Show End Sub を削除します。 ユーザーフォーム用のMouseDown、MouseMoveイベントの例文も不要なら削除します
標準モジュール メインプロシージャ 長いですが、いじる 必要はないはず	Public Sub MoveWidth(ByVal UF As Variant, ByVal UFW As Boolean, ByVal x As Single, _ 　　　　　　　　　　　　　　 ByVal MoveW As Variant,ByVal MoveL As Variant, _ 　　　　　　　　 Optional ByVal ListC As Control, Optional ByVal ColNo As Integer) Dim CW, B,　　c As Control, W As Single, ClW As Single Dim i As Long, j As Long Const AlW As Single = 100　　　　　　　　　　　　　　　　　　　　　'フォーム最小幅(87以下にはならない模様) W = x - CSng(UF.Tag) If IsArray(MoveW) Then 　　For i = 0 To UBound(MoveW) 　　　　MoveW(i) = MoveW(i).Name 　　Next End If If IsArray(MoveL) Then 　　For i = 0 To UBound(MoveL) 　　　　MoveL(i) = MoveL(i).Name 　　Next End If For j = 0 To 1　　　　　　　　　　　　　　　　　　　　　　　　　　　　'1回目はチェック、2回目で調整します 　　With UF 　　　　If .Width + W < AlW And W < 0 Then GoTo EndSec　　'最小幅より狭くはしない 　　　　If j > 0 And UFW Then .Width = .Width + W　　　　　　　'フォーム幅調整 　　End With '------------------------------　　　　コントロ−ルのWidth調整　　　　------------------------------- 　　If IsArray(MoveW) Then 　　　　For i = 0 To UBound(MoveW) 　　　　　　With UF.Controls(MoveW(i)) 　　　　　　　　If .Width + W < 0 Then GoTo EndSec　　　　　　'マイナス幅はエラーになります 　　　　　　　　If j > 0 Then .Width = .Width + W 　　　　　　End With 　　　　Next 　　End If '------------------------------　　　　オプション リスト幅調整　　　　------------------------------- 　　If Not ListC Is Nothing Then　　　　　　　　　　　　　　　　　'リストボックスを想定 　　　　With ListC 　　　　　　CW = Split(.ColumnWidths, ";")　　　　　　　　　　　'"0 pt;36 pt;84 pt;54 pt;45 pt" 　　　　　　ClW = CSng(Replace(CW(ColNo), " pt", "")) 　　　　　　If ClW + W < 0 Then GoTo EndSec 　　　　　　If j > 0 Then CW(ColNo) = ClW + W: .ColumnWidths = Join(CW, ";") 　　　　End With 　　End If Next '------------------------------　　　　コントロ−ルのLeft 調整　　　　------------------------------- If IsArray(MoveL) Then 　　For i = 0 To UBound(MoveL) 　　　　With UF.Controls(MoveL(i)) 　　　　　　.Left = .Left + W 　　　　End With 　　Next End If UF.Repaint If W < 0 Then Application.ScreenUpdating = True EndSec: Set c = Nothing Set UF = Nothing If IsArray(CW) Then Erase CW If IsArray(B) Then Erase B End Sub '　変数説明　　　UF　　ユーザーフォームを渡しています。(変更不可・必須) '　　　　　　　　　UFW　　ユーザーフォームの幅を調整する場合TRUE(必須) '　　　　　　　　　　ｘ　　　MouseMoveイベントで拾ったｘをそのまま渡しています。(変更不可・必須) '　　　　　　　　MoveW　幅を調整したいコントロールを配列で受け取ります。(必須) '　　　　　　　　MoveL　位置を調整したいコントロールを配列で受け取ります。(必須) '　　　　　　　　　　　　　いづれも数字や文字など配列以外を渡すと対象コントロールは無しの設定となります。 '　　　　　　　　 ListC　オプション(省略可能)　列幅を調整したいリストボックス '　　　　　　　　ColNo　オプション(省略可能)　列幅を調整したい列番号

メンテナンス上の留意点

特にどうというものもないんですが、位置や幅の調整を独立して処理してますんで、いろいろ動かしていると戻にくくなります。

被調整コントロールのタグに初期Left、初期Width、初期ColumnWidths値カンマ区切などで書き込んでリセットボタンで戻してやる。

とか、何か考えんといかんかもです。

やってみた感想

●コンセプト

移植可能な部品としてのとりまとめを考えました。
なるべく定型のコードをコピペで、必要部分のみ書き換え　といった移植作業を目指してみました。
ですので、

１.	フォーム上には呼出用の透明ラベルを手動で配置していただく。
２.	呼出コードは定型部分が多くなるように
３.	標準モジュールコードはそのままで他のフォームと共用で使えるように

ほぼ実現できたように思います。

●起こった問題点と対処

まあ、コード書きなら常識なんでしょうけど、ちょっと苦労しちゃいました。
参考になれば。

問　題　点	対　　処
引数のコントロールを配列に入れてます。 ・・・, Array(ListBox1, La2), Array(LaW4, LaW), ListBox1, 4 な感じです。 で、いきなり調整してたんですが、チェックが必要と気づきまして2回ループにしたらコントロールに2回目のアクセスが出来ない。	チェックできるが動かない 「実行時エラー　424　オブジェクトが必要です」、なんで？？？？ じゃ、　Set UF = MoveW(0).Parent　でアクセスした分はなんでOKなんだろ？ Arrayにコントロール名、直打ち　小文字が大文字に勝手に変換されて存在チェックがその場で出来るんだよな〜 コントロール名を文字列で渡せばちゃんと動くのは確認。 泣く泣く、コントロールを文字列に変換してます。 誰が見ても　「何しとん？？」　だよな〜。 この現象は2000・2003・2007・2010・2013で確認しています
ユーザーフォームの幅って87以上なの？	VBEのユーザーフォーム作成画面で確認できます。 このプログラムで調整かけるとやっぱり87未満にはなりません。 仕様なんでしょうね。
MultiPage・Frame対応	コンテナと呼ばれています。 コントロールのParentでユーザーフォームにたどり着けません。 Frameは1個上、MultiPageはPageがあって、その上にMultiPageがあってなので、2個上。 入れ子になってたりするとコントロールのParentでユーザーフォームを取得するのに迷子になってしまいそう。 なので、ユーザーフォームは別に第1引数で渡すことにします。 あと、ユーザーフォームの幅は変えないで、フォームの中だけで移動･幅変更したい場合、第2引数に幅変更ON/OFFを追加しました。
UF.Repaint Application.ScreenUpdating = True	Repaint　はフォームの中を書き直してくれます。 動かしてると白抜きのフォームを見られちゃうので必要です。 ScreenUpdating　はフォームの外側に　縮めた時の残像でくし模様が出来るのが見られます。
リストボックスのColumnWidths オプションですが調整できます。	コンボボックスにもあるプロパティですが、数字+" pt"を列ごとにカンマ区切りの文字列で表現しています。 大変マニアックな仕様です 引数ColNoで中の数字を取り出して、書き換えして、Join関数でつなぎ直して、戻すことで列幅が変更できます。 「だからどうなんだ」　と言う声が聞こえてきそうです。　知ってる人は驚かない。
Private Sub Cancel_Click() Unload Me End Sub	表示中にフォームのレイアウトを変えているわけで、どっかでUnLoadしないと、いじり倒したフォームがそのまま出てきちゃいます。 普通は初期状態が見やすいものだと思います。

小ネタ

ラベルでコマンドボタンの動きを模倣してみました。
ボタンを押したときに　ボタン自体は盛り（Raised）から掘り（Sunken)にかわりテキストはやや右下へ動きます。
ほかに、押している間はテキストを点線で囲むような表示も出ますがこちらは無視。

実用性は、限りなく？？？？？？です。(たぶん私は使わんが、趣味の世界と言うことで)
3個のラベルたちで、たった1個のコマンドボタンに化けます。
ラベルを起動ボタンに使うのは、ユーザーフォームのレイアウトの都合でよくあることですが。

コントロール名	表示順序	役　割	説　明	初期状態
LaBack	一番下	BackColor	ボタンの表面色です。 フォームと同じならこれは必要ないです。	特になし
LaBtnTx	中間	Caption	表示するテキスト、ボタンの中心に配置します。 ラベルは上下方向の位置指定ができないので	色は透明。 位置は中心。
LaButton	一番上	SpecialEffect	クリック操作を受付します。 盛り（Raised）と掘り（Sunken)の切り替え	色は透明。 盛り（Raised）

Private Sub LaButton_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
　　　　　　　　　　　　　　　　　　　　　　ByVal X As Single, ByVal Y As Single)
LaButton.SpecialEffect = fmSpecialEffectSunken
With LaBtnTx
　　If Len(.Tag) = 0 Then .Tag = .Left & "," & .Top
　　.Top = .Top + 1
　　.Left = .Left + 1
End With
End Sub

Private Sub LaButton_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
　　　　　　　　　　　　　　　　　　　　 ByVal X As Single, ByVal Y As Single)
Dim Buf
LaButton.SpecialEffect = fmSpecialEffectRaised
With LaBtnTx
　　 Buf = Split(.Tag, ",")
　　.Left = CSng(Buf(0))
　　.Top = CSng(Buf(1))
End With
'実際の動作コードはこのあたりとか
Erase Buf
End Sub

こうやって見ると、コマンドボタンってよく創ってあるなぁ。