|
Excel VBAで画面サイズを縦幅のみ変更可能にし、
横幅を常に固定表示させるフォームを実現させるため、
以下のようなコードを書きました。
モーダルフォームに対しては、意図した動きになるのですが
モーダレスフォームに対しては、画面が表示された段階で
CPUの負荷が常に100%になり、EXCELが固まってしまいます。
ちなみにVBではモーダルフォーム、モーダレスフォームに対しても意図した動きになります。
Excel VBAのモーダレスフォームに対して画面サイズ変更を実現させるには
どうすればいいのでしょうか?
皆さんのお知恵をお貸し下さい。
------------------------------------------------
Private Sub UserForm_Initialize()
'ユーザーフォームのハンドル取得
hwnd = FindWindow("ThunderDFrame", Me.Caption)
'フックの開始
OldWp = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf fncWndProc)
End Sub
------------------------------------------------
Public Function fncWndProc( _
ByVal hwnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
'RECTワーク
Dim wkRect As RECT
'関数返値の初期値
fncWndProc = 0
'フックしたメッセージの振り分けと対処
Select Case uMsg
Case WM_SIZING
Call MoveMemory(wkRect, ByVal lParam, LenB(wkRect))
'横幅は固定
wkRect.Right = wkRect.Left + 250
'縦幅は50ピクセル刻み
wkRect.Bottom = wkRect.Top + ((wkRect.Bottom - wkRect.Top) \ 50) * 50
Call MoveMemory(ByVal lParam, wkRect, Len(wkRect))
Case Else
fncWndProc = CallWindowProc(OldWp, hwnd, uMsg, wParam, lParam)
End Select
End Function
------------------------------------------------
|
|