Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


9548 / 13644 ツリー ←次へ | 前へ→

【26679】UserFormのアイコン変更について ぱくぱく 05/7/14(木) 0:12 質問[未読]
【26719】Re:UserFormのアイコン変更について bykin 05/7/14(木) 21:58 回答[未読]
【26767】Re:UserFormのアイコン変更について ぱくぱく 05/7/17(日) 2:16 お礼[未読]

【26679】UserFormのアイコン変更について
質問  ぱくぱく  - 05/7/14(木) 0:12 -

引用なし
パスワード
   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を取得してつか
ってみたのですが、値は取得できるのですが上手く行きません。なにか間違って
入るのでしょうか?ツールバーへのアイコン作成はこのイメージを使って
行うことができました。どうか宜しくお願い致します。

【26719】Re:UserFormのアイコン変更について
回答  bykin  - 05/7/14(木) 21:58 -

引用なし
パスワード
   こんばんわ。

>最初の起動では上手く行くのですが、一度Unloadして、もう一度呼び出すと
>アイコンの変更がなされません。

なんかようわからんねんけど、グローバル変数の値をチェックしてみたんかな?

>If g_lngFormIcon <> 0 Then

が怪しいような気ぃすんねんけど。

ユーザーフォームを出すたびに同じアイコンを表示させるんやったら、
グローバル変数なんか使う必要ないんとちゃいまっか?
それに全部をひとつのプロシージャにまとめても問題ないと思うねんけどな。

とりあえず、標準モジュールを1個に合体して、コードもまとめたら・・・
(フォームモジュールはそのまま)

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

Private Declare Function SendMessage Lib "user32" _
        Alias "SendMessageA" _
        (ByVal hWnd As Long, _
        ByVal wMsg As Long, _
        ByVal wParam As Long, _
        lParam As Any) As Long

Private Declare Function ExtractIcon Lib "shell32.dll" _
        Alias "ExtractIconA" _
        (ByVal hInst As Long, _
        ByVal lpszExeFileName As String, _
        ByVal nIconIndex As Long) 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
   Dim g_lngFormIcon As Long
  
'   hWnd = FindWindow("ThunderRT6DFrame", uf.Caption)  'DLL用
   hWnd = FindWindow("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))
   g_lngFormIcon = ExtractIcon(0, "C:\Program Files\Microsoft Office\OFFICE11\MSN.ICO", 0)
   If g_lngFormIcon <> 0 Then
    Call SendMessage(hWnd, WM_SETICON, False, ByVal g_lngFormIcon)
   End If
   Ret = DrawMenuBar(hWnd)
End Sub

ところで・・・(以下は私見なんで無視してもろて結構です)
わては、アドインにはアイコンは不要と思ってます。
●アドインは元アプリ(エクセル)の内部で動くものであり、それだけで独立していない。
 だから別アプリのように見せる必要はない。
●アイコンを表示させると、×ボタンも表示されてしまうが、フォームを閉じる方法の
 選択肢が増えるのは好ましくない。
・・・と考えてるからです。
ま、×ボタンを非表示にしたらアイコンが表示できんってことやねんけど(^^;;

それと、ばくばくはんのコードではExcel97に配慮してるようやけど、COMアドインは
2000以降限定にしたほうがええと思うよ。
っていうか、97でも動くんかな?
VBAのバージョンが97と2000以降では違ってるねんけどな・・・

提示したコードでうまいこといかんかったらかんにんな。
ほな。

【26767】Re:UserFormのアイコン変更について
お礼  ぱくぱく  - 05/7/17(日) 2:16 -

引用なし
パスワード
   bykin さん、いつもありがとうございます。

いただいたコードのとおりグローバル変数なんか使わずに、毎回呼び出せば直りました。ありがとうございます。ご迷惑をおかけしてますが、少しずつトライすべき事柄のコツみたいなことが分かってきました。

>●アドインは元アプリ(エクセル)の内部で動くものであり、、、、

おっしゃるとおりです。あんまり意味のない機能でだいぶコードが肥大化もしますね。もともとはOffice-DevのUFormの標準のアイコンが変なので、変えてやる!という発想でしたが、消してしまったほうが賢い気がしてきました。

>Excel97に配慮してるようやけど、COMアドインは2000以降限定にしたほうがええと思うよ。

↑に関しては、混乱させてしまって申し訳ございません。デバックモード時のウィンドウクラス名のところだと思いますが、これは前から使っていたコードをめんどだったのでそのまま貼り付けて使っていました。意味ないけど、問題ないからいいかなとほうっておきました。ごめんなさい。

9548 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free