| |
いつも参考にさせていただいてます。
過去ログで調べたのですがわからないので
ご教授お願いします。
電卓の表示位置を変更したいのですが変更方法がわかりません
どなたかお解りなる方
よろしくお願いします。
Option Explicit
' 対象ウィンドウを探しウィンドウハンドルを取得するAPI
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
ByVal lpszCalss As String, ByVal lpszWindow As String) As Long
Private Const HWND_TOPMOST As Long = -1& ' 最前面に
Private Const SWP_NOSIZE As Long = &H1& ' サイズ変更しない
Private Const SWP_NOMOVE As Long = &H2& ' 表示位置変更しない
' ウィンドウの表示サイズ/位置を設定するAPI
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _
ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long) As Long
' ウィンドウが存在するかどうか確認するAPI
Private Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Const WM_GETTEXT As Long = &HD& ' テキストを取得
Private Const WM_CLOSE As Long = &H10 ' 閉じる
' ウィンドウにメッセージを送るAPI(※lParamが文字列型なのに注意(本来はLong型))
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As String) As Long
Private hWnd As Long ' 電卓のウィンドウハンドル
Private hEditWnd As Long ' 電卓のエディットボックスのウィンドウハンドル
' 電卓を起動し、最前面に表示させる
Private Sub CommandButton1_Click()
' 電卓を表示する
Application.ActivateMicrosoftApp Index:=0
' 電卓のウィンドウハンドルを取得する
hWnd = FindWindowEx(0&, 0&, "SciCalc", "電卓")
' 電卓内のエディットボックスのウィンドウハンドルを取得する
hEditWnd = FindWindowEx(hWnd, 0&, "Edit", vbNullString)
' 最前面に表示
SetWindowPos hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE
End Sub
' 電卓の値をテキストボックスに入れる
Private Sub CommandButton2_Click()
' 電卓のウィンドウがある場合
If IsWindow(hWnd) > 0 Then
' 電卓のテキストボックスの値を取得
Me.TextBox1.Text = GetCalcText
End If
End Sub
' 電卓を終了させる
Private Sub CommandButton3_Click()
' 電卓のウィンドウがある場合
If IsWindow(hWnd) > 0 Then
' 「閉じる」処理を電卓側に処理させる
SendMessage hWnd, WM_CLOSE, 0, vbNullChar
End If
End Sub
' 電卓のテキストボックスの値を取得する
Private Function GetCalcText() As String
Dim calcText As String
' エディットボックスの文字列を取得する
calcText = String(255, vbNullChar)
If SendMessage(hEditWnd, WM_GETTEXT, Len(calcText), calcText) > 0 Then
GetCalcText = Left$(calcText, InStr(calcText, vbNullChar) - 1)
End If
End Function
Private Sub CommandButton4_Click()
ActiveCell.Value = TextBox1.Value
End Sub
' 電卓の値をテキストボックスに入れる
Private Sub CommandButton6_Click()
' 電卓のウィンドウがある場合
If IsWindow(hWnd) > 0 Then
' 電卓のテキストボックスの値を取得
ActiveCell.Value = GetCalcText
End If
End Sub
Private Sub CommandButton8_Click()
Selection.ClearContents
End Sub
Private Sub Image1_Click()
' 電卓を起動し、最前面に表示させる
' 電卓を表示する
Application.ActivateMicrosoftApp Index:=0
' 電卓のウィンドウハンドルを取得する
hWnd = FindWindowEx(0&, 0&, "SciCalc", "電卓")
' 電卓内のエディットボックスのウィンドウハンドルを取得する
hEditWnd = FindWindowEx(hWnd, 0&, "Edit", vbNullString)
' 最前面に表示
SetWindowPos hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE
End Sub
Private Sub TextBox1_Change()
TextBox1.Text = Format(TextBox1.Text, "#,##0")
End Sub
Private Sub UserForm_Initialize()
Const POINTS_PER_INCH = 66 'この数値変更で移動
Dim dblWidth As Double
Dim dblHeight As Double
' 画面の大きさをポイント単位で取得
With CreateObject("htmlfile")
With .parentwindow.screen
'availWidth, avaiHeight というのもあり
'MsgBox "解像度： " & .Width & " x " & .Height
dblWidth = .Width * POINTS_PER_INCH / .deviceXDPI
dblHeight = .Height * POINTS_PER_INCH / .deviceYDPI
End With
End With
' 位置の設定
Me.StartUpPosition = 0
Me.Left = dblWidth - Me.Width
Me.Top = dblHeight - Me.Height
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
