[[20250919082820]]　『終了時の処理方法について』（栗栄太）　ページの最後に飛ぶ

『終了時の処理方法について』（栗栄太）

フォルダに Main.xlsmとSub.xlsx を作成します。
Main.xlsm のフォームに ufmMain を追加します。
Main.xlsm の ThisWorkbook に以下を追加します。

 Private Sub Workbook_Open()
    ufmMain.StartUpPosition = 0
    ufmMain.Top = Application.Top + ((Application.Height - ufmMain.Height) / 2)
    ufmMain.Left = Application.Left + ((Application.Width - ufmMain.Width) / 2)
    ufmMain.Show vbModeless
 End Sub

ufmMain に以下を追加します。

 Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Dim var As Variant
    Application.ScreenUpdating = False: Application.DisplayAlerts = False
    For Each var In Application.Workbooks
        Select Case var.Name
        Case ThisWorkbook.Name
        Case Else
            Unload Me
            ThisWorkbook.Close
            Exit Sub
        End Select
    Next
    Application.Quit
 End Sub

まず、Main.xlsm を開くとフォームが表示されます。
右上の[×]を押して終了します。
再度Main.xlsm を開きますが、問題なく表示されます。

次に Sub.xlsx を開きます。
この状態で、Main.xlsm を開きます。
右上の[×]を押して終了します。
再度Main.xlsm を開くと以下のエラーが表示されます。
「ActiveXコンポーネントはオブジェクトを作成できません。」
デバッグボタンを押すと
「ufmMain.StartUpPosition = 0」の箇所で停止します。
エラーが出ないように動作させるにはどうすればよいのでしょうか？

＜使用 Excel：Microsoft365、使用 OS：Windows11 ＞

いろいろ試してみました。

以下のようにすると２度目の表示位置がおかしくなります。

 Private Sub Workbook_Open()
    On Error Resume Next
    ufmMain.StartUpPosition = 0
    ufmMain.Top = Application.Top + ((Application.Height - ufmMain.Height) / 2)
    ufmMain.Left = Application.Left + ((Application.Width - ufmMain.Width) / 2)
    ufmMain.Show vbModeless
 End Sub

以下のようにすると２度目のフォームが表示されなくなります。（画面外かも？）

 Private Sub Workbook_Open()
    On Error Resume Next
    ufmMain.Show vbModeless
    ufmMain.StartUpPosition = 0
    ufmMain.Top = Application.Top + ((Application.Height - ufmMain.Height) / 2)
    ufmMain.Left = Application.Left + ((Application.Width - ufmMain.Width) / 2)
 End Sub

以下のようにすると２度目のフォームは正しく表示されようにはなりました。

 Private Sub Workbook_Open()
    On Error Resume Next
    ufmMain.StartUpPosition = 0
    ufmMain.Top = Application.Top + ((Application.Height - ufmMain.Height) / 2)
    ufmMain.Left = Application.Left + ((Application.Width - ufmMain.Width) / 2)
    ufmMain.Show vbModeless
    ufmMain.StartUpPosition = 0
    ufmMain.Top = Application.Top + ((Application.Height - ufmMain.Height) / 2)
    ufmMain.Left = Application.Left + ((Application.Width - ufmMain.Width) / 2)
 End Sub

でも、すっきりしません。
（栗栄太） 2025/09/19(金) 09:28:34

おはようございまあす(*^^*)
ユーザーフォーム。。。いろいろありますよね^^:
私も良く理解できていませんので便乗でお勉強させて戴きます。
回答は出来ないかもしれません。お邪魔でなければ、教えて戴ければ幸甚です
フォームのデザイン方法は？
Ａ．あらかじめ手動で作成済み
Ｂ．コードで起動時に作成
起動モードは
Ａ．モーダル
Ｂ．モードレス
A^^;
早く回答が有れば良いですね
<< _ _ >>

（隠居Z） 2025/09/19(金) 10:13:57

失礼致しました
モードレスですね
すんまそ
m(__)m
試して見ます
（隠居Z） 2025/09/19(金) 10:16:27

 正面突破で...

    Private Declare PtrSafe Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds As Long)
    Private Sub Workbook_Open()
        On Error Resume Next
        Dim i As Long
        For i = 1 To 10
            ufmMain.StartUpPosition = 0
            If Err.Number = 0 Then Exit For
            Err.Clear
            Debug.Print Now; i
            DoEvents
            Sleep 50
        Next
        On Error GoTo 0
        ufmMain.Top = Application.Top + ((Application.Height - ufmMain.Height) / 2)
        ufmMain.Left = Application.Left + ((Application.Width - ufmMain.Width) / 2)
        ufmMain.Show vbModeless
    End Sub

（白茶） 2025/09/19(金) 10:23:16

フォームがロードされるまで、時間待ちと言う事でせうか。。。(*^^*)
m(__)m
（隠居Z） 2025/09/19(金) 10:36:04

（白茶）さん 2025/09/19(金) 10:23:16
で
正解みたいですね。当方では再現しなくなりましたです。
m(__)m
（隠居Z） 2025/09/19(金) 10:42:33

ありがとうございます。

こちらもエラーが出なくなりました。
どうすればこういう考え方ができたのか素晴らしいですね。
予想すらできませんでした。

なぜ１度目はでないのでしょうか？

（栗栄太） 2025/09/19(金) 13:28:54

 > なぜ１度目はでないのでしょうか？

 いやー、それはわかりませんねぇ...
 私がメインで使用しているのはExcel2010なんですけど、
 MDIとSDIの違いなのか、2010ではそもそも問題なくフォームが表示されました。
 (2019でやってみたらエラーが再現できた)

（白茶） 2025/09/19(金) 16:09:47

 Private Sub Workbook_Open()
    Dim i As Long
    Dim e As Long

    For i = 1 To 100
        On Error Resume Next
        Load ufmMain
        e = Err.Number
        On Error GoTo 0
        If e = 0 Then Exit For
    Next
    On Error GoTo 0
    If i > 10 Then
        MsgBox "ユーザーフォームが見つかりませんでした。"
        Exit Sub
    End If

    ufmMain.StartUpPosition = 0
    ufmMain.Top = Application.Top + ((Application.Height - ufmMain.Height) / 2)
    ufmMain.Left = Application.Left + ((Application.Width - ufmMain.Width) / 2)
    ufmMain.Show vbModeless
 End Sub

 >どうすればこういう考え方ができたのか

エラーを無視して何回かチャレンジしてみたら、
ユーザーフォームが開く。
または、エラーが出た後、デバッグで手動で続行させてみる。
こういう感じでうまくいくなら、
乱暴にエラーを無視して、ひたすら命令を繰り返したら
よさそうと想像できるので、ループしてうまくいくまで待とうかという発想になるかと。
（まっつわん） 2025/09/19(金) 18:24:38

なるほどです。
いろいろとありがとうございました。
（栗栄太） 2025/09/22(月) 12:58:31

コメント返信：

[ 一覧(最新更新順) ]

[[20250919082820]] 『終了時の処理方法について』（栗栄太） ページの最後に飛ぶ

[[20250919082820]]　『終了時の処理方法について』（栗栄太）　ページの最後に飛ぶ