ユーザーフォームのやつ
自分だけ楽したい人のためのEXCEL VBA
ユーザーフォームのサイズ変更ができるようにする
2021/10/28 23:010
前の記事
次の記事
ホーム
今回もすぐに使えるプロシージャを紹介していきます。
今回は、ユーザーフォームのサイズ変更ができるようにするプロシージャを紹介します。
<引用元>
今回はほとんど下記サイトより引用し、一部改良しています。
https://vbabeginner.net/change-form-size-minimize-and-maximize/
改良点はユーザーフォームのサイズ変更時(Resize時)にコントロールや文字サイズが同じような比率で変更されるようになっている点です。
<実行サンプル>
https://drive.google.com/drive/folders/1RTh8BL8QfX8yHL-qxU4BUfcwsNVWbfWn?usp=sharing
<使い方>
実行サンプルで起動するユーザーフォームに登録してあるコードです。
ユーザーフォームのイベントプロシージャで
ActivateイベントにてSetFormEnableResizeプロシージャを実行します。
InitializeイベントにてInitializeFormResizeプロシージャをMe(自身のフォームオブジェクト)を渡して実行します。
ResizeイベントにてResizeFormプロシージャをMe(自身のフォームオブジェクト)を渡して実行します。
<コード解説>
技術1:ユーザーフォームがリサイズ可能にする。
ユーザーフォームのリサイズ設定は上記のサイトを参考にしてください。
技術2:各コントロール、文字サイズも追随してリサイズ
コントロールや文字サイズをユーザーフォームのサイズに対して変わらないように変更する方法となります。
言い換えるとユーザーフォームのサイズと各コントロールや文字のサイズ、位置関係の比率を常に一定となるようにしています。
今回は初期状態での各コントロールや文字サイズのユーザーフォームのサイズとの比率と、
ユーザーフォームをリサイズ前後のユーザーフォームのサイズを取得して、リサイズ後の各コントロールや文字サイズのユーザーフォームのサイズを変更する方法をとっています。
この処理にはPrivate変数を用いています。
またコントロールの種類によっては同じ処理を行うとエラーになったりする場合もあるので、場合分けの処理も必要になります。
<広告>
Excelでの自動化のサポートをココナラの方で請け負っています。
ご相談からでも構いませんので、気軽にご連絡ください。
<コード>
Option Explicit
'// Win32API用定数
Private Const GWL_STYLE = (-16)
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_THICKFRAME = &H40000
'// Win32API参照宣言
'// 64bit版
#If VBA7 And Win64 Then
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As Long
Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
'// 32bit版
#Else
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
#End If
Private PriIniWidth As Double 'ユーザーフォームのリサイズ前の幅
Private PriIniHeight As Double 'ユーザーフォームのリサイズ前の高さ
Private PriResizeCount As Long 'ユーザーフォームのリサイズ回数
Private PriFontSizeRateList() As Double '各コントロールのフォントサイズ変更用の比率を格納
Public Sub SetFormEnableResize()
'参考:https://vbabeginner.net/change-form-size-minimize-and-maximize/
'ユーザーフォームのリサイズを可能にする
'ユーザーフォームのイベント(UserForm_Activate)で実行する
'↓をActivateイベントに貼り付けてコメント解除
' Call SetFormEnableResize
'20211007
#If VBA7 And Win64 Then
Dim hwnd As LongPtr 'ウインドウハンドル
Dim style As LongPtr 'ウインドウスタイル
#Else
Dim hwnd As Long 'ウインドウハンドル
Dim style As Long 'ウインドウスタイル
#End If
'ウインドウハンドル取得
hwnd = GetActiveWindow()
'ウインドウのスタイルを取得
style = GetWindowLong(hwnd, GWL_STYLE)
'ウインドウのスタイルにウインドウサイズ可変+最小ボタン+最大ボタンを追加
style = style Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
'ウインドウのスタイルを再設定
Call SetWindowLong(hwnd, GWL_STYLE, style)
End Sub
Public Sub InitializeFormResize(TargetForm As Object)
'ユーザーフォームのリサイズ用の初期設定
'ユーザーフォームのイベント(UserForm_Initialize)で実行する。
'↓をInitializeイベントに貼り付けてコメント解除
' Call InitializeFormResize(Me)
'20211007
'引数
'TargetForm・・・対象とするユーザーフォーム/オブジェクト型
PriIniHeight = TargetForm.Height '初期状態のユーザーフォームの高さ取得
PriIniWidth = TargetForm.Width '初期状態のユーザーフォームの幅取得
PriResizeCount = 0 'リサイズの回数初期化
End Sub
Public Sub ResizeForm(TargetForm As Object, Optional FontSizeResize As Boolean = True)
'ユーザーフォームのコントロールをリサイズする
'ユーザーフォームのイベント(UserForm_Resize)で実行する
'↓をResizeイベントに貼り付けてコメント解除
' Call ResizeForm(Me)
'20211007
'引数
'TargetForm ・・・対象とするユーザーフォーム/オブジェクト型
'[FontSizeResize]・・・フォントサイズを変更するかどうか/Boolean型/デフォルトではサイズ変更する
PriResizeCount = PriResizeCount + 1 'リサイズの回数+1
Dim TmpControl As MSForms.Control 'ユーザーフォーム内の各コントロール
Dim NowFormHeight As Double
Dim NowFormWidth As Double 'サイズ変更後のユーザーフォームのサイズ
Dim HeightRate As Double
Dim WidthRate As Double 'サイズ変更によるサイズの比率変化
Dim Top1 As Double
Dim Left1 As Double
Dim Height1 As Double
Dim Width1 As Double
Dim FontSize1 As Double '変更前の各サイズ
Dim Top2 As Double
Dim Left2 As Double
Dim Height2 As Double
Dim Width2 As Double
Dim FontSize2 As Double '変更後の各サイズ
NowFormHeight = TargetForm.Height 'リサイズ後のユーザーフォームの高さ取得
NowFormWidth = TargetForm.Width 'リサイズ後のユーザーフォームの幅取得
HeightRate = NowFormHeight / PriIniHeight 'リサイズ前後での高さ比率
WidthRate = NowFormWidth / PriIniWidth 'リサイズ前後での幅比率
Dim K As Long
If PriResizeCount = 1 Then 'コントロールの数だけフォントサイズの比率の初期状態を保存しておく
ReDim PriFontSizeRateList(1 To TargetForm.Controls.Count)
K = 0
For Each TmpControl In TargetForm.Controls '各コントロールのフォントサイズ/(高さ+幅)を取得
K = K + 1
FontSize1 = 0
On Error Resume Next 'コントロールによってはフォントがない場合もあるのでその際のエラー回避
FontSize1 = TmpControl.FontSize
If FontSize1 <> 0 Then
PriFontSizeRateList(K) = FontSize1 / (TmpControl.Height + TmpControl.Width)
Else
FontSize1 = TmpControl.Font.Size 'ツリービューやリストビューはこのプロパティ設定
If FontSize1 <> 0 Then
PriFontSizeRateList(K) = FontSize1 / (TmpControl.Height + TmpControl.Width)
End If
End If
On Error GoTo 0
Next
End If
K = 0
For Each TmpControl In TargetForm.Controls
K = K + 1
With TmpControl 'コントロールのリサイズ前の位置、サイズ取得
Top1 = .Top
Left1 = .Left
Height1 = .Height
Width1 = .Width
' FontSize1 = .FontSize
End With
'コントロールのリサイズ後の位置、サイズ計算
Top2 = Top1 * HeightRate
Left2 = Left1 * WidthRate
Height2 = Height1 * HeightRate
Width2 = Width1 * WidthRate
'コントロールのリサイズ後のフォントサイズ計算
FontSize2 = (Height2 + Width2) * PriFontSizeRateList(K) 'フォントサイズは高さと幅に対する比率で設定
With TmpControl 'コントロールのリサイズ後の位置、サイズ、フォントサイズ設定
.Top = Top2
.Left = Left2
.Height = Height2
.Width = Width2
If FontSizeResize = True Then
On Error Resume Next 'コントロールによってはフォントがない場合もあるのでその際のエラー回避
.FontSize = FontSize2
.Font.Size = FontSize2
On Error GoTo 0
End If
End With
Next
'次のリサイズの際のために、現在のユーザーフォームの高さ、幅を取っておく
PriIniHeight = NowFormHeight
PriIniWidth = NowFormWidth
End Sub
view rawUserFormResize hosted with ❤ by GitHub
コメントを書く
コメント(0件)
「ツール紹介」カテゴリの最新記事
VBA開発強力支援ツール「階層化フォーム」の紹介
ExcelVBAでPCログを取得して残業時間自動集計
エクセル スピログラフ
カテゴリ
ツール紹介
タグ
VBA
LINEで更新通知を受け取る
前の記事
次の記事
ホーム
LINEで送るこのエントリーをはてなブックマークに追加
コメントを書く
読者ボタン
ブログリーダー
Feedly
趣味・創作一般 カテゴリ人気ブログ
1
花組『元禄バロックロック』新着キャストボイスは柚香光&星風...
大好き宝塚☆のんびりつぶやきBl...
2
10月26日13時予約開始! MG 1/100 ターンエー...
シナウス。 ~限定品薄在庫復活...
3
【ミニ四駆】ノーシステムの考え方をメインマシンに!➁
サブカル”ダディ”ガッテム日記
4
フィリップス電気シェーバー( PT764/14 )分解 修理
モモンハン日記
5
LITS 229
ニコリ系パズルの逆襲[弍]
もっとみる
編集部の「推し」
ボンネットが開閉するミニカーボンネットが開閉するミニカー
愛猫の腎不全発覚から5年経過
去年"サイズをミスった"服が…
「秋の表情を求めて in 秋田」
美味しくできた"サバ缶パスタ"
フランスの"ヴィンテージ家具"
芋の味が甘く、香りがいい焼酎
大量の古本を店に持ち込んだら
もっとみる
急上昇ブログ
UPほわわん子育て絵日記
UPおうちマニア
UPくららんち。~B型夫婦と猫2匹の日常~
UPつれさか -徒然サッカー雑記-
UPちこえ official blog
UPひだまりマーチ
UPぱれちにっき
UPもっちのママ友トラブル・子育て漫画
UPHIROのおいしいおうちごはん日記
UP生活のメモ
UP☆まかりな☆のにこにこ漫画ブログ
UPSMILE BENTO
UP写真で魅力発掘 ~暮らしのフォトダイアリー~
UPたれまゆ日和
UPざくろ❤倶楽部
UP幸の食べ痩せ食堂
UPコウノトリが二羽飛んできた
UPめめみズム!
UP海外の反応で英語の勉強
UP魚の4コマ
もっとみる
暮らしブログ速報
【自分を癒やす大切な時間】自分も周りも幸せにするために
The essence of life
【本】与えられ脳から、自分軸へ*思いどおりの成果をだすには
MakeLife+ゆとり時間
TAUPE
綺麗をひと匙~Illustrator...
絵日記
料理
暮らし
ペット
おすすめ連載
1500g未満の赤ちゃん
"極低出生体重児"だった、娘の誕生の物語。
イケメン彼氏は〇〇が大好き!?
オシャレで会話が面白い彼と1回目のデートで破局! そのわけは…?
箱入娘面屋人魚
江戸時代に作られた"ヘンテコな作品"を漫画でお届け!
もっとみる
ブログ
ランキング
ブログ速報
ブログリーダー
livedoor Blog
PCモード
トップへ
Powered by livedoor Blog