[[20250123125234]]　『ユーザーフォーム(UserForm1)の移動につきまして』（はる）　ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

　

『ユーザーフォーム(UserForm1)の移動につきまして』（はる）

Excel画面起動時にユーザーフォーム(UserForm1)を表示させています。
Excel画面位置を移動した場合ユーザーフォームの位置は移動されません。

Excel画面を移動した時に同じくユーザーフォーム(UserForm1)位置も同じく
移動する方法につきまして宜しくお願い致します。

＜ 使用 Excel：Excel2019、使用 OS：Windows10 ＞

 リアルタイムでなくていいならショートカットキーなどで
 ユーザーフォームの位置を移動させる、というのが手っ
 取り早いような気がします。


 あるいはOnTimeメソッドでアプリケーションウィンドウ
 の位置を取得して移動させるとか。
（OK） 2025/01/23(木) 13:32:12
モニター画面上で、エクセルのウィンドウを移動したときに、
ユーザーフォームもエクセルのウィンドウの相対的に同じ位置に
リアルタイムで追随させたいということでしょうか？
それとも、何かしらの操作で（ボタンクリック等）、
エクセルのウィンドウ上の決まった位置に移動できればよいのでしょうか？

（まっつわん） 2025/01/23(木) 13:35:52

OK　さん 

 >リアルタイムでなくていいならショートカットキーなどで
 >ユーザーフォームの位置を移動させる、というのが手っ
 >取り早いような気がします。
  はい、分かりました。
 >あるいはOnTimeメソッドでアプリケーションウィンドウ
 >の位置を取得して移動させるとか。
  はい、分かりました。


 ありがとうございました。

（はる） 2025/01/23(木) 13:46:11

まっつわん　さん 

 >モニター画面上で、エクセルのウィンドウを移動したときに、
 >ユーザーフォームもエクセルのウィンドウの相対的に同じ位置に
 >リアルタイムで追随させたいということでしょうか？
 はい、その通りで間違いありません。


 ありがとうございました。
（はる） 2025/01/23(木) 13:47:24

 あー、ひょっとして
 例えば↓これとかニュアンス近くないですか?
[[20230610173616]]　『ユーザーフォームをExcelウィンドウの動きに合わａx（ちくわ）


    Option Explicit
    Private Declare PtrSafe Function SetParent Lib "user32" (ByVal hWndChild As LongPtr, ByVal hWndNewParent As LongPtr) As LongPtr
    Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc.dll" (ByVal IAcessible As Object, ByRef hWnd As LongPtr) As Long


    Private Sub UserForm_Initialize()
        Dim hMe As LongPtr, hXl As LongPtr
        WindowFromAccessibleObject Me, hMe
        SetParent hMe, Application.hWnd
    End Sub

（白茶） 2025/01/23(木) 13:49:59

 (しまった hXl 定義したけど使ってない.../// )

（白茶） 2025/01/23(木) 14:01:18

白茶 さん

現在はExcel画面起動時にユーザーフォーム(UserForm1)をA2セル位置で表示させています。

Private Sub Workbook_Open() 

    UserForm1.Show vbModeless

End Sub

Private Sub UserForm_Initialize() 

   Dim dblX As Double, dblY As Double
    With ActiveWindow
        dblX = .PointsToScreenPixelsX(0) / 96 * 72 + Range("A2").Left * .Zoom / 100
        dblY = .PointsToScreenPixelsY(0) / 96 * 72 + Range("A2").Top * .Zoom / 100
    End With
    With Me
        .StartUpPosition = 0
        .Left = dblX
        .Top = dblY
    End With


  Exit Sub


 >モニター画面上で、エクセルのウィンドウを移動したときに、
 >ユーザーフォームもエクセルのウィンドウの相対的に同じ位置に
 >リアルタイムで追随させたいということです。
　エクセルのウィンドウを移動したときでもユーザーフォームも常にA2セル位置で表示させたいと思います。


 >Private Sub UserForm_Initialize()
 >Dim hMe As LongPtr, hXl As LongPtr
 >WindowFromAccessibleObject Me, hMe
 >SetParent hMe, Application.hWnd
 >End Sub

　UserForm_Initializeにどの様な位置に記載すれば分かりません。
　知識不足ですので、ご了承下さい。

　ありがとうございました。

（はる） 2025/01/23(木) 14:14:33

Workbook_WindowResize　というイベントはあるけど、

WindowChanged
WindowMovedOrResized

というようなイベントは用意されてないので、
難しそう。。。。

ユーザーフォームをダブルクリックするとかで、
初期位置に戻してはいかがでしょうか？
（まっつわん） 2025/01/23(木) 14:33:54

まっつわん さん 

 >Workbook_WindowResize　というイベントはあるけど、
 間違っていなければ移動しても認識されませんでした。[x]で閉じた時に認識されました。


 >・・というようなイベントは用意されてないので、難しそう
　はい、大変、参考になりました。


 >ユーザーフォームをダブルクリックするとかで、
 >初期位置に戻してはいかがでしょうか？
　はい、分かりました。

　ありがとうございました。
（はる） 2025/01/23(木) 14:44:10

 WindowのLeft位置またはTop位置を動かすようにすればよいのでは？
 または、
 全体を移動したあと追加で、Left位置ないしTop位置を微小量だけ移動させればよいのでは？


 コードは例えば以下のようにしては?


 <UserForm1モジュール>
 Private Sub UserForm_Initialize()
     Call setposition
 End Sub


 Sub setposition()
     Dim dblX As Double, dblY As Double
     With ActiveWindow
         dblX = .PointsToScreenPixelsX(0) / 96 * 72 + Range("A2").Left * .Zoom / 100
         dblY = .PointsToScreenPixelsY(0) / 96 * 72 + Range("A2").Top * .Zoom / 100
     End With
     With Me
         .StartUpPosition = 0
         .Left = dblX
         .Top = dblY
     End With
 End Sub


 <ThisWorkbookモジュール>
 Private Sub Workbook_WindowResize(ByVal Wn As Window)
     Call UserForm1.setposition
 End Sub

（xyz） 2025/01/23(木) 15:20:27

 UserForm1が起動しているときだけ、その動作をさせるには以下でしょうか。
 （尤も、さきほど提示したコードでも不具合はでないかもしれませんが、無駄な処理をすることになるようです。
   詳しく調べていませんが。）


 Private Sub Workbook_WindowResize(ByVal Wn As Window)
     Dim isVisible As Boolean
     On Error Resume Next
     isVisible = UserForm1.Visible    
     On Error GoTo 0


     If isVisible Then
         Call UserForm1.setposition
     End If
 End Sub
（xyz） 2025/01/23(木) 15:38:44
xyz さん

以下の提供を下さいまして、ありがとうございました。 

 >コードは例えば以下のようにしては?
　はい、分かりました。
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
<UserForm1モジュール>
 Private Sub UserForm_Initialize()
     Call setposition
 End Sub


 Sub setposition()
     Dim dblX As Double, dblY As Double
     With ActiveWindow
         dblX = .PointsToScreenPixelsX(0) / 96 * 72 + Range("A2").Left * .Zoom / 100
         dblY = .PointsToScreenPixelsY(0) / 96 * 72 + Range("A2").Top * .Zoom / 100
     End With
     With Me
         .StartUpPosition = 0
         .Left = dblX
         .Top = dblY
     End With
 End Sub


 <ThisWorkbookモジュール>
 Private Sub Workbook_WindowResize(ByVal Wn As Window)
     Call UserForm1.setposition
 End Sub
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
　実際にExcel画面を移動後、少し上下または左右画面を少し伸縮させるとユーザーフォーム(UserForm1)が
　A2セル位置に移動できました。今後、ご提供の方法で使用させていただきます。

ありがとうございました。

　
（はる） 2025/01/23(木) 15:45:36

xyz さん

度重ね、ありがとうございました。 

 >UserForm1が起動しているときだけ、その動作をさせるには以下でしょうか。
 >（尤も、さきほど提示したコードでも不具合はでないかもしれませんが、
 >無駄な処理をすることになるようです。
 >詳しく調べていませんが。）

以下を提供下さいまして、ありがとうございました。

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 

 Private Sub Workbook_WindowResize(ByVal Wn As Window)
     Dim isVisible As Boolean
     On Error Resume Next
     isVisible = UserForm1.Visible    
     On Error GoTo 0


     If isVisible Then
         Call UserForm1.setposition
     End If
 End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
以下のコードが必要無くなりました。 

 >Private Sub UserForm_Initialize()
 >     Call setposition
 >End Sub

今後、ご提供の方法で使用させていただきます。

ありがとうございました。

（はる） 2025/01/23(木) 16:03:42

済みません。訂正があります。

以下のコードが必要無くなりました。 　　訂正　↓
以下のコードは必要有ります。 
 >Private Sub UserForm_Initialize()
 >     Call setposition
 >End Sub
（はる） 2025/01/23(木) 16:50:50

 > >モニター画面上で、エクセルのウィンドウを移動したときに、
 > >ユーザーフォームもエクセルのウィンドウの相対的に同じ位置に
 > >リアルタイムで追随させたいということでしょうか？
 > はい、その通りで間違いありません。


 白茶さんの回答のコードでご希望の動作になると思います。
 やっていることは、APIでユーザーフォームをエクセルウィンドをの子ウィンドウに設定しています。
 こちらの環境(365)で動作確認済みです。


 > UserForm_Initializeにどの様な位置に記載すれば分かりません。
 > 知識不足ですので、ご了承下さい。


 とのことなので、補足しますと、Declare部分はモジュールの先頭に、
 UserForm_Initialize部分は現状のUserForm_Initializeの最後に挿入すればいいだけです。


 Option Explicit
 Private Declare PtrSafe Function SetParent Lib "user32" (ByVal hWndChild As LongPtr, ByVal hWndNewParent As LongPtr) As LongPtr
 Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc.dll" (ByVal IAcessible As Object, ByRef hWnd As LongPtr) As Long


 Private Sub UserForm_Initialize()
    Dim dblX As Double, dblY As Double
    With ActiveWindow
        dblX = .PointsToScreenPixelsX(0) / 96 * 72 + Range("A2").Left * .Zoom / 100
        dblY = .PointsToScreenPixelsY(0) / 96 * 72 + Range("A2").Top * .Zoom / 100
    End With
    With Me
        .StartUpPosition = 0
        .Left = dblX
        .Top = dblY
    End With


    Dim hMe As LongPtr
    WindowFromAccessibleObject Me, hMe
    SetParent hMe, Application.hWnd
 End Sub


 ただし、モーダルで開いてしまうとエクセルの操作ができなくなりますので、
 かならずモードレスで開くようにする必要があります。
 ユーザーフォームのプロパティのShowModalをFalseにしておくけば安全でしょう。

（hatena） 2025/01/24(金) 09:45:54

 上記のコードだとエクセルウィンドウがスクリーンの左上の場合はいいですが、
 そうでないとA2セル上にこないですね。
 子ウィンドウにすると親ウィンドウの左上が原点になるので。
 その辺を考慮して位置調整する必要性があります。
（hatena） 2025/01/24(金) 13:31:57

 下記でよさげな感じです。


 Option Explicit
 Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
 End Type


 Private Declare PtrSafe Function SetParent Lib "user32" (ByVal hWndChild As LongPtr, ByVal hWndNewParent As LongPtr) As LongPtr
 Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc.dll" (ByVal IAcessible As Object, ByRef hWnd As LongPtr) As Long
 Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As Long


 Private Sub UserForm_Initialize()
    Dim structWndowPosition As RECT
    GetWindowRect Application.hWnd, structWndowPosition


    Dim dblX As Double, dblY As Double
    With ActiveWindow
        dblX = (.PointsToScreenPixelsX(0) - structWndowPosition.Left) / 96 * 72 + Range("A2").Left * .Zoom / 100
        dblY = (.PointsToScreenPixelsY(0) - structWndowPosition.Top) / 96 * 72 + Range("A2").Top * .Zoom / 100
    End With


    With Me
        .StartUpPosition = 0
        .Left = dblX
        .Top = dblY
    End With


    Dim hMe As LongPtr
    WindowFromAccessibleObject Me, hMe
    SetParent hMe, Application.hWnd


 End Sub

（hatena） 2025/01/24(金) 14:07:11

hatena さん

返答くださいまして、ありがとうございました。

返答が遅れまして大変申し訳ありませんでした。

ご提供して下さいました下記のコードを<UserForm1モジュール>にしましたら
Excel画面を移動した時に同じくユーザーフォーム(UserForm1)位置も同じく移動できました。
今後も下記のコードを利用させてもらいます。

'<UserForm1モジュール>

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 

  >Option Explicit
  >Private Type RECT
    >Left As Long
    >Top As Long
    >Right As Long
    >Bottom As Long
  >End Type


  >Private Declare PtrSafe Function SetParent Lib "user32" (ByVal hWndChild As LongPtr, ByVal hWndNewParent As LongPtr) As LongPtr
  >Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc.dll" (ByVal IAcessible As Object, ByRef hWnd As LongPtr) As Long
  >Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As Long


  >Private Sub UserForm_Initialize()
     >Dim structWndowPosition As RECT
     >GetWindowRect Application.hWnd, structWndowPosition


     >Dim dblX As Double, dblY As Double
     >With ActiveWindow
         >dblX = (.PointsToScreenPixelsX(0) - structWndowPosition.Left) / 96 * 72 + Range("A2").Left * .Zoom / 100
         >dblY = (.PointsToScreenPixelsY(0) - structWndowPosition.Top) / 96 * 72 + Range("A2").Top * .Zoom / 100
     >End With


     >With Me
        >.StartUpPosition = 0
        >.Left = dblX
        >.Top = dblY
     >End With


     >Dim hMe As LongPtr
     >WindowFromAccessibleObject Me, hMe
     >SetParent hMe, Application.hWnd


  >End Sub
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

ありがとうございました。

（はる） 2025/01/25(土) 07:46:48

コメント返信：

[ 一覧(最新更新順) ]

YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.