|
OfficeXP DeveloperでCOMアドインの作成にチャレンジしているぱくぱくです。
一つ進んでは、またつまづいてしまっています、、。
UserFormのInitialize時に最大・最小化ボタンを消し、サイズ変更を無効にし、
さらに、右上にオリジナルのアイコンを表示させようとしています。
以下のコードを作成したのですが、最初の起動では上手く行くのですが、
一度Unloadして、もう一度呼び出すとアイコンの変更がなされません。
がんばってみたのですが、お手上げです。どなたかお知恵を拝借させてください。
---UserForm---
Private Sub UserForm_Initialize()
Call InitializeUserForm(Me)
End Sub
---標準モジュール---
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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 DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const WS_MAXIMIZEBOX = &H10000 '最大化ボタン
Const WS_MINIMIZEBOX = &H20000 '最小化ボタン
Const WS_THICKFRAME = &H40000 'サイズ変更
Const GWL_STYLE = (-16)
Const WM_SETICON = &H80
Const ICON_SMALL = 0&
Const ICON_BIG = 1&
'最大化最小化ボタンなし、サイズ変更不可
Public Sub InitializeUserForm(uf As UserForm)
Dim hWnd As Long
Dim Ret As Long
Dim MySetWin As Long
hWnd = FindWindow("ThunderRT6DFrame", uf.Caption) 'DLL用
'hWnd = FindWindow(IIf(Application.Version < 9, "ThunderXFrame", "ThunderDFrame"), uf.Caption) 'デバックモード用
MySetWin = GetWindowLong(hWnd, GWL_STYLE)
Ret = SetWindowLong(hWnd, GWL_STYLE, MySetWin And (Not WS_MAXIMIZEBOX) _
And (Not WS_MINIMIZEBOX) _
And (Not WS_THICKFRAME))
Call SetIcon(hWnd)
Ret = DrawMenuBar(hWnd)
End Sub
Private Sub SetIcon(hWnd As Long)
Dim Ret As Long
If g_lngFormIcon <> 0 Then
Call SendMessage(hWnd, WM_SETICON, False, ByVal g_lngFormIcon)
End If
End Sub
---標準モジュール2---
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" _
(ByVal hInst As Long, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long
'▲ アイコンイメージの取得(グローバル変数に格納)
Public Sub GetIconImage()
'ユーザーフォーム用アイコンの取得
g_lngFormIcon = ExtractIcon(0, g_regDLLPath & strIconName, 0)
'↑icoファイルを指定して取得。パス等はグローバル変数を使っています。
'g_lngFormIcon = icoForm.Image1.Picture.Handle
End Sub
↑もう一つ質問なのですが、Q&Aラウンジ ExcelVBAで見かけたコードを
参考に、フォームにアイコンを貼り付けそのイメージのHandleを取得してつか
ってみたのですが、値は取得できるのですが上手く行きません。なにか間違って
入るのでしょうか?ツールバーへのアイコン作成はこのイメージを使って
行うことができました。どうか宜しくお願い致します。
|
|