Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

76505 / 76807

←次へ　｜　前へ→


	【4724】GetDesktopWindow

こう

- 03/4/3(木) 18:15 -


	引用なし

	パスワード

あゆさん，こんにちわ。

マイクロソフトサポート技術情報 - 404924
[AC95] 画面の解像度を調べる方法
http://support.microsoft.com/default.aspx?scid=http://www.microsoft.com/japan/support/kb/articles/404/9/24.asp
からの情報を元にちょっと改修してみました。

以下のコードを「標準モジュール」に貼り付けてください。
　 Dim xx, yy As Integer
　 Type RECT
　　　 x1 As Long
　　　 y1 As Long
　　　 x2 As Long
　　　 y2 As Long
　 End Type
　
　 Declare Function GetDesktopWindow Lib "User32" () As Long
　 Declare Function GetWindowRect Lib "User32" _
　　　　　　　 (ByVal hWnd As Long, rectangle As RECT) As Long

　 Function GetScreenResolution() 'As String
　 Dim R As RECT
　 Dim hWnd As Long
　 Dim RetVal As Long
　　　 hWnd = GetDesktopWindow()
　　　 RetVal = GetWindowRect(hWnd, R)
　　　 'GetScreenResolution = (R.x2 - R.x1) & "x" & (R.y2 - R.y1)
　　　 xx = R.x2 - R.x1
　　　 yy = R.y2 - R.y1
　 End Function
　 '---------------------------------------------------------------
　 Sub xxx()
　　　 Call GetScreenResolution
　　　
　　　 UserForm1.Height = yy * 0.75
　　　 UserForm1.Width = xx * 0.75
　　　 UserForm1.Show vbModeless
　　　　　　' :
　　　　　　'処理
　　　　　　' :
　　　　　　Application.Wait (Now + TimeValue("0:00:05"))
　　　 Unload UserForm1
　　　 MsgBox "処理が終了しました"
　 End Sub

求めた画面サイズの単位がピクセル，ユーザフォームのサイズがポイント
なので，変換(x0.75)しています。

この変換についてのネタ元↓
http://www21.tok2.com/home/vbalab/bbs/c-board.cgi?cmd=one;no=9565;id=Excel
Thanx!! > JuJuさん(^^)

1 hits

▼

【4681】マクロのuserformを全画面表示したい あゆ 03/4/2(水) 17:31