Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 11 Pro : Excel 2021)
ModelessモードのUserFormを最前面に表示
投稿日時: 23/10/25 11:08:02
投稿者: O.M

ModelessモードのUserFormを最前面に表示する方法を教えていただきたいです。
 
Jw_cad というCADの外部変形という機能で、
図面内のデータの変換をしているのですが、外部変形からExcelで作成した変換ソフト
(Excelのブックは非表示として、Excelのユーザーフォームのみ表示し変換内容を指示)を起動した際に、
ユーザーフォームが常にjw_cadの背面に潜ってしまいます。
 
Jw_cadの外部変形機能→batファイル起動
→batファイルからvbsファイルを起動(vbsファイル終了まで待機)
→Vbsファイルからエクセルを起動(エクセル終了まで待機)
→Excel(ブック非教示、ユーザーフォームのみ表示)から変換指示を出し実行し変換、Excelを閉じる
 
という形を取っており、VBSファイルの記述は
 

Option Explicit
Private FSO, VbsObject , VbsPath , VbsName, FolderPath, BookName, BookPath, wb, flag
Set FSO = CreateObject("Scripting.FileSystemObject")
Set VbsObject =FSO.GetFile(WScript.ScriptFullName)
VbsName = VbsObject.Name
FolderPath = VbsObject.ParentFolder
BookName = LEFT(VbsName,LEN(VbsName)-4) & ".xls"
BookPath = FolderPath & "\" & BookName
If FSO.FileExists(BookPath) then
  With CreateObject("Excel.Application")
    .Visible = False
    .Workbooks.Open(BookPath)
    On Error resume Next
    Do 
      flag = false
      For Each wb In .Workbooks
        If wb.Name = BookName Then flag = True
      Next
      If flag = true Then
        WScript.Sleep 500
      Else
        Exit Do
      End If
    Loop 
    On Error goto 0
  End With
Else
  Wscript.echo BookPath & vblf & " が存在しません。"
End IF

 
となっています。
 
下記サイトさんのコードユーザーフォームに貼り付けたうえで、
https://www.monote.org/vba-form-top/
 
UserForm_InitializeのコードにSetForegroundWindow mhwndFormを追加してみたりもしたのですが、
jw_cadの画面とバッチファイルの画面の後ろにユーザーフォームが潜ってしまいます。
 
前面に表示させる方法がございましたら教えていただきたいです。
よろしくお願いいたします。
 

投稿日時: 23/10/25 11:35:30
投稿者: O.M

エクセル側の起動時の処理は
 
エクセルが非表示の場合ユーザーフォームを起動とし
 

Private Sub Workbook_Open()
  If Application.Visible = False Then
    UserForm1.Show vbModeless
  End If
End Sub

 
ユーザーフォーム起動時にエクセルの設定シートから設定を読み込み
ユーザーフォーム上に設置したコントロールの表示切り替えを実施しています。
 

'【ユーザーフォーム起動】
Private Sub UserForm_Initialize()
  Dim i As Long
  Dim St As Worksheet
  Dim udtJwDataConvert As JwDataConvert
  Set St = ThisWorkbook.Sheets("設定")
  On Error GoTo ErrHndl
  'Pageセレクト
  MultiPage1.Value = St.Cells(1, 1).Value
  '取得データ
  For i = 1 To 10
    Controls("Data" & i).Value = St.Cells(i, 2).Value
  Next
  '置換
  For i = 1 To 5
    Controls("Conv" & i).Value = St.Cells(i, 3).Value
  Next
  For i = 30 To 39
    Controls("RepCc" & i - 30).Value = St.Cells(i, 3).Value
  Next
  '全角半角変換
  For i = 1 To 8
    Controls("CheckBox" & i).Value = St.Cells(i, 4).Value
  Next
  For i = 30 To 39
    Controls("StrHanCc" & i - 30).Value = St.Cells(i, 4).Value
  Next
  For i = 40 To 49
    Controls("StrZenCc" & i - 40).Value = St.Cells(i, 4).Value
  Next
  '大小変換
  For i = 1 To 3
    Controls("OptionButton" & i).Value = St.Cells(i, 5).Value
  Next
  For i = 30 To 39
    Controls("StrDaiSyouCc" & i - 30).Value = St.Cells(i, 5).Value
  Next
  '追加
  For i = 1 To 18
    Controls("Add" & i).Value = St.Cells(i, 6).Value
  Next
  For i = 30 To 39
    Controls("AddCc" & i - 30).Value = St.Cells(i, 6).Value
  Next
  '削除
  For i = 1 To 18
    Controls("Del" & i).Value = St.Cells(i, 7).Value
  Next
  For i = 30 To 39
    Controls("DelCc" & i - 30).Value = St.Cells(i, 7).Value
  Next
  '書式変換
  For i = 1 To 1
    Controls("FormConv" & i).Value = St.Cells(i, 8).Value
  Next
  For i = 40 To 49
    Controls("FormConvCc" & i - 40).Value = St.Cells(i, 8).Value
  Next
  'コントロールの表示
  Call ConvEnabled
  Call ZenHanEnabled
  Call AddEnabled
  Call DelEnabled
  
Exit Sub
ErrHndl:
  MsgBox "データ読込失敗しました。"
End Sub


 
Private Sub ConvEnabled()
  If Conv1.Value = "" Then
    CommandButton2.Enabled = False
    CommandButton15.Enabled = False
  Else
    CommandButton2.Enabled = True
    CommandButton15.Enabled = True
  End If
End Sub

Private Sub ZenHanEnabled()
  Dim i As Byte, Flg As Boolean
  For i = 1 To 4
    If Controls("CheckBox" & i).Value = True Then
     Flg = True
    End If
  Next
  If Flg = False Then
    CommandButton4.Enabled = False
  Else
    CommandButton4.Enabled = True
  End If
End Sub

Private Sub AddEnabled()
  Dim i As Byte
  'データ変換
  For i = 1 To 6
    If Controls("Add" & i).Value = True Then
      Controls("Add" & i * 2 + 5).Enabled = True
      Controls("Add" & i * 2 + 6).Enabled = True
    Else
      Controls("Add" & i * 2 + 5).Enabled = False
      Controls("Add" & i * 2 + 6).Enabled = False
    End If
  Next
End Sub

Private Sub DelEnabled()
  Dim i As Byte
  'データ変換
  For i = 1 To 6
    If Controls("Del" & i).Value = True Then
      Controls("Del" & i * 2 + 5).Enabled = True
      Controls("Del" & i * 2 + 6).Enabled = True
    Else
      Controls("Del" & i * 2 + 5).Enabled = False
      Controls("Del" & i * 2 + 6).Enabled = False
    End If
  Next
End Sub

投稿日時: 23/10/25 12:20:30
投稿者: O.M

 
下記サイト様のコードで解決しました。
https://liclog.net/set-always-foreaground-function-vba-api/#google_vignette