Excel VBA質問箱 IV

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

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


7691 / 13644 ツリー ←次へ | 前へ→

【37460】特定の名前のブックが開かれているかどう... 黄金比 06/5/8(月) 19:02 質問[未読]
【37467】Re:特定の名前のブックが開かれているかど... ネット徘徊者 06/5/8(月) 20:16 発言[未読]
【37470】Re:特定の名前のブックが開かれているかど... ichinose 06/5/8(月) 23:26 発言[未読]
【37471】Re:特定の名前のブックが開かれているかど... Kein 06/5/9(火) 0:30 回答[未読]
【37472】Re:特定の名前のブックが開かれているかど... Blue 06/5/9(火) 0:44 発言[未読]
【37473】Re:特定の名前のブックが開かれているかど... Kein 06/5/9(火) 1:37 発言[未読]
【37476】Re:特定の名前のブックが開かれているかど... Blue 06/5/9(火) 11:08 発言[未読]

【37460】特定の名前のブックが開かれているかどう...
質問  黄金比  - 06/5/8(月) 19:02 -

引用なし
パスワード
   特定の名前のブックが開かれているかどうかを調べたいのですが、
下記のメソッドですと同じExcelウインド内では判定できますが、
別ExcelウインドのBOOKは判定できません。

なにか有効な方法はありますでしょうか?
よろしくお願いします。

---------------------------------------------------
Sub Sample()
Dim myChkBook As Workbook
  On Error GoTo ErrHdl
  Set myChkBook = Workbooks("Sample.xls")
  MsgBox "開かれています。"
  Exit Sub
ErrHdl:
  MsgBox "開かれていません。"
End Sub
---------------------------------------------------

【37467】Re:特定の名前のブックが開かれているか...
発言  ネット徘徊者  - 06/5/8(月) 20:16 -

引用なし
パスワード
   ここではマルチポストは禁止されてませんが、
あちらのサイトではマルチポストは禁止され
てます。

各々のサイトの掲示板規約、ネチケットを守
りましょう。

【37470】Re:特定の名前のブックが開かれているか...
発言  ichinose  - 06/5/8(月) 23:26 -

引用なし
パスワード
   こんばんは。
やっぱり、休み明け・・、ボケてました。
一応、再送です。
でも、これでは 黄金比さんの求めているものと違うかもしれません。

'======================================
Sub main()
  Dim bk As Workbook
  Set bk = findbk("D:\TESTエリア\testarea\sample.xls")
  If Not bk Is Nothing Then
    MsgBox bk.Name
  Else
    MsgBox "not found"
    End If
End Sub
'=======================================================
Function findbk(fullpath As String) As Object
  On Error Resume Next
  dim myarray as variant
  Application.EnableEvents = False
  myarray = Split(fullpath, "\")
  Set findbk = Workbooks(myarray(UBound(myarray)))
  If Err.Number <> 0 Then
    Err.Clear
    Set findbk = GetObject(fullpath)
    If findbk.Parent Is Application Then
     findbk.Close False
     Set findbk = Nothing
     End If
    End If
  Application.EnableEvents = True
End Function

【37471】Re:特定の名前のブックが開かれているか...
回答  Kein  - 06/5/9(火) 0:30 -

引用なし
パスワード
   いちおう、Win32APIを使う方法も提示しておきます。

Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, _
lPalam As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Sub Check_MyBook()
  Dim Ret As Long
    
  Ret = EnumWindows(AddressOf Rekkyo, 0&)
End Sub

Function Rekkyo(ByVal hWndX As Long, lParam As Long) As Boolean
  Dim Name As String
  Dim Leng As Long, Ret As Long

  Name = String(250, Chr(0))
  Leng = Len(Name)
  Ret = GetWindowText(hWndX, Name, Leng)
  If Ret <> 0 Then
   If Name Like "*BookX.xls*" Then
     MsgBox "BookX.xls は開いています", 64
     Exit Function
   End If
  End If
  Rekkyo = True
End Function

【37472】Re:特定の名前のブックが開かれているか...
発言  Blue  - 06/5/9(火) 0:44 -

引用なし
パスワード
   この方法って、Bookのウィンドウを最大化していないとEnumWindowsに列挙されなさそうですけどどうでしょうか?

【37473】Re:特定の名前のブックが開かれているか...
発言  Kein  - 06/5/9(火) 1:37 -

引用なし
パスワード
   あー・・そうですね。いつも最大化して使っていたために、そーいうことは
気が付きませんでした。
それならば EnumChildWindows なんかを使えば出来るかもしれません。
でも今日はもう寝ますので、またあらためて・・。

【37476】Re:特定の名前のブックが開かれているか...
発言  Blue  - 06/5/9(火) 11:08 -

引用なし
パスワード
   FindWindowExで試しにつくってみました。
ただし、結構条件を限定していますので、Excelのバージョンによっては使えないかもしれません。

Option Explicit

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
  (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
   ByVal lpszClass As String, ByVal lpszWindow As String) As Long
' GetWindowTextWを使用(戻り値でLeft$したいから)
Private Declare Function GetWindowText _
  Lib "user32" Alias "GetWindowTextW" _
  (ByVal hWnd As Long, ByVal lpString As Long, _
   ByVal nMaxCount As Long) As Long

Sub test()
  Const strBookPath As String = "D:\TESTエリア\testarea\sample.xls"
  If IsExistBook(strBookPath) Then
    MsgBox strBookPath & "は開いています。"
  Else
    MsgBox strBookPath & "は開いていません。"
  End If
End Sub

' 該当のBookを開いているかどうかを調査する関数(FindWindowEx使用)
' 動作確認 : Windows Xp Pro Sp2, Excel 2002 Sp3
Private Function IsExistBook(ByVal strBookPath As String) As Boolean
  Dim hXLMainWnd As Long
  Dim hXLDeskWnd As Long
  Dim strTitle  As String
  Dim lngLen   As Long
  Dim strBookName As String
  
  ' ブック名の取得(ファイルタイトル)
  strBookName = Dir(strBookPath)
  
  Do
    ' EXCELウィンドウの取得(クラス名 "XLMAIN" で列挙)
    hXLMainWnd = FindWindowEx(0&, hXLMainWnd, "XLMAIN", vbNullString)
    ' EXCELウィンドウはもうないので終わり
    If hXLMainWnd = 0 Then Exit Do
    ' EXCELのウィンドウタイトルの取得
    strTitle = String(256, vbNullChar)
    lngLen = GetWindowText(hXLMainWnd, StrPtr(strTitle), 256)
    If lngLen > 0 Then
      strTitle = Left$(strTitle, lngLen)
      ' Bookを最大化していない場合
      ' (ウィンドウタイトル "Microsoft Excel" で該当とする)
      If strTitle = "Microsoft Excel" Then
        ' MDIのウィンドウ(?)を取得(クラス名 "XLDESK" で取得)
        hXLDeskWnd = FindWindowEx(hXLMainWnd, 0&, _
                     "XLDESK", vbNullString)
        If hXLDeskWnd <> 0 Then
          ' 該当のBookが開いているかどうか(Book名で検索する)
          If FindWindowEx(hXLDeskWnd, 0&, _
                  vbNullString, strBookName) <> 0 Then
            IsExistBook = True
            Exit Function
          End If
        End If
      ' Bookを最大化している場合
      ' (ウィンドウタイトル "Microsoft Excel - Book名" で該当とする)
      ElseIf strTitle Like "Microsoft Excel - " & strBookName Then
        IsExistBook = True
        Exit Function
      End If
    End If
  Loop
End Function

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