Excel VBA質問箱 IV

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

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


30207 / 76738 ←次へ | 前へ→

【51798】電卓の表示位置について教えて
質問  吉田  - 07/10/5(金) 2:00 -

引用なし
パスワード
   いつも参考にさせていただいてます。
過去ログで調べたのですがわからないので
ご教授お願いします。
電卓の表示位置を変更したいのですが変更方法がわかりません
どなたかお解りなる方
よろしくお願いします。
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

0 hits

【51798】電卓の表示位置について教えて 吉田 07/10/5(金) 2:00 質問
【51811】Re:電卓の表示位置について教えて neptune 07/10/5(金) 13:48 回答
【51812】Re:電卓の表示位置について教えて 吉田 07/10/5(金) 14:09 質問
【51813】Re:電卓の表示位置について教えて neptune 07/10/5(金) 14:55 回答

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