none
Excel2016 「PERSONAL.XLSB」VBAからVBEを操作する(開く)…help RRS feed

  • 質問

  • 掲題の件、次の質問で解決済みコードとして利用し始めていたのですが、
    https://social.msdn.microsoft.com/Forums/ja-JP/9dc9d029-cb6a-4e4d-9c81-3b899db899a0/excel2016-personalxlsbvbavbe?forum=vbajp
     ↓↓
    ターゲットファイル名が長かった場合、
    「If (InStr(item.CurrentName, x) > 0) Then」がヒットしません…「展開」できません。
    「item.CurrentName」にファイル名が格納しきれていない(オーバーフロー)様子です。
    Debug.Print item.CurrentName →VBAProject (UiE2240 ○○○店舗別売上管理D_V18.0101.x...)
    回避方法をご教授よろしくお願いします。

      For i = 0 To ar.Length - 1
        Dim item As UIAutomationClient.IUIAutomationElement
        Set item = ar.GetElement(i)
      
        Dim x As String
        x = "(" & WB.Name & ")"
        
        If (InStr(item.CurrentName, x) > 0) Then
          Debug.Print item.CurrentName
      
          Dim ex As UIAutomationClient.IUIAutomationExpandCollapsePattern
          Set ex = item.GetCurrentPattern(UIA_PatternIds.UIA_ExpandCollapsePatternId)
          If (expand) Then
            ex.expand
          Else
            ex.Collapse
          End If
      
        End If
      Next


    u793nabe

    2018年3月4日 8:38

回答

  • Project名を重複しない名前に付け替えてから判定してみる

    Option Explicit
    
    Sub Test()
        Call ExpandProjectTree(ActiveWorkbook, False)
        MsgBox "TEST"
        Call ExpandProjectTree(ActiveWorkbook, True)
    End Sub
    
    Sub ExpandProjectTree(ByVal wb As Workbook, ByVal expand As Boolean)
        Application.VBE.MainWindow.Visible = True
        Dim w As VBIDE.Window
        For Each w In Application.VBE.Windows
            If (w.Type = vbext_wt_ProjectWindow) Then
                w.Visible = True
                Exit For
            End If
        Next
    
        If (w Is Nothing) Then
            Exit Sub
        End If
    
        Dim hwnd As LongPtr
        hwnd = w.hwnd
        Dim uia As UIAutomationClient.CUIAutomation
        Dim wndIDE As UIAutomationClient.IUIAutomationElement
        Dim wndProj As UIAutomationClient.IUIAutomationElement
        Dim eTree As UIAutomationClient.IUIAutomationElement
        Set uia = New UIAutomationClient.CUIAutomation
        Dim con As UIAutomationClient.IUIAutomationPropertyCondition
    
        Set con = uia.CreatePropertyCondition(UIA_PropertyIds.UIA_NativeWindowHandlePropertyId, Application.VBE.MainWindow.hwnd)
        Set wndIDE = uia.GetRootElement().FindFirst(TreeScope_Children, con)
    
        Set con = uia.CreatePropertyCondition(UIA_PropertyIds.UIA_ClassNamePropertyId, "PROJECT")
        Set wndProj = wndIDE.FindFirst(TreeScope_Subtree, con)
    
        Set con = uia.CreatePropertyCondition(UIA_PropertyIds.UIA_ControlTypePropertyId, UIA_ControlTypeIds.UIA_TreeControlTypeId)
        Set eTree = wndProj.FindFirst(TreeScope_Subtree, con)
    
        Set con = uia.CreatePropertyCondition(UIA_PropertyIds.UIA_ControlTypePropertyId, UIA_ControlTypeIds.UIA_TreeItemControlTypeId)
        Dim ar As UIAutomationClient.IUIAutomationElementArray
        Set ar = eTree.FindAll(TreeScope_Children, con)
        Dim i As Integer
        
        Dim p As VBIDE.VBProject
        Set p = wb.VBProject
        Dim name As String
        Const DUMMYNAME As String = "D_U_M__M_Y"
        name = p.name
        p.name = DUMMYNAME
        
        
        For i = 0 To ar.Length - 1
            Dim item As UIAutomationClient.IUIAutomationElement
            Set item = ar.GetElement(i)
    
            Dim x As String
            x = "(" & wb.name & ")"
            If (Len(item.CurrentName) > Len(DUMMYNAME)) Then
                If (Left(item.CurrentName, Len(DUMMYNAME)) = DUMMYNAME) Then
                    Debug.Print item.CurrentName
        
                    Dim ex As UIAutomationClient.IUIAutomationExpandCollapsePattern
                    Set ex = item.GetCurrentPattern(UIA_PatternIds.UIA_ExpandCollapsePatternId)
                    If (expand) Then
                        ex.expand
                    Else
                        ex.Collapse
                    End If
        
                End If
            End If
        Next
        
        p.name = name
    End Sub


    個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

    • 回答としてマーク u793nabe 2018年3月5日 21:18
    2018年3月5日 5:57

すべての返信

  • Project名を重複しない名前に付け替えてから判定してみる

    Option Explicit
    
    Sub Test()
        Call ExpandProjectTree(ActiveWorkbook, False)
        MsgBox "TEST"
        Call ExpandProjectTree(ActiveWorkbook, True)
    End Sub
    
    Sub ExpandProjectTree(ByVal wb As Workbook, ByVal expand As Boolean)
        Application.VBE.MainWindow.Visible = True
        Dim w As VBIDE.Window
        For Each w In Application.VBE.Windows
            If (w.Type = vbext_wt_ProjectWindow) Then
                w.Visible = True
                Exit For
            End If
        Next
    
        If (w Is Nothing) Then
            Exit Sub
        End If
    
        Dim hwnd As LongPtr
        hwnd = w.hwnd
        Dim uia As UIAutomationClient.CUIAutomation
        Dim wndIDE As UIAutomationClient.IUIAutomationElement
        Dim wndProj As UIAutomationClient.IUIAutomationElement
        Dim eTree As UIAutomationClient.IUIAutomationElement
        Set uia = New UIAutomationClient.CUIAutomation
        Dim con As UIAutomationClient.IUIAutomationPropertyCondition
    
        Set con = uia.CreatePropertyCondition(UIA_PropertyIds.UIA_NativeWindowHandlePropertyId, Application.VBE.MainWindow.hwnd)
        Set wndIDE = uia.GetRootElement().FindFirst(TreeScope_Children, con)
    
        Set con = uia.CreatePropertyCondition(UIA_PropertyIds.UIA_ClassNamePropertyId, "PROJECT")
        Set wndProj = wndIDE.FindFirst(TreeScope_Subtree, con)
    
        Set con = uia.CreatePropertyCondition(UIA_PropertyIds.UIA_ControlTypePropertyId, UIA_ControlTypeIds.UIA_TreeControlTypeId)
        Set eTree = wndProj.FindFirst(TreeScope_Subtree, con)
    
        Set con = uia.CreatePropertyCondition(UIA_PropertyIds.UIA_ControlTypePropertyId, UIA_ControlTypeIds.UIA_TreeItemControlTypeId)
        Dim ar As UIAutomationClient.IUIAutomationElementArray
        Set ar = eTree.FindAll(TreeScope_Children, con)
        Dim i As Integer
        
        Dim p As VBIDE.VBProject
        Set p = wb.VBProject
        Dim name As String
        Const DUMMYNAME As String = "D_U_M__M_Y"
        name = p.name
        p.name = DUMMYNAME
        
        
        For i = 0 To ar.Length - 1
            Dim item As UIAutomationClient.IUIAutomationElement
            Set item = ar.GetElement(i)
    
            Dim x As String
            x = "(" & wb.name & ")"
            If (Len(item.CurrentName) > Len(DUMMYNAME)) Then
                If (Left(item.CurrentName, Len(DUMMYNAME)) = DUMMYNAME) Then
                    Debug.Print item.CurrentName
        
                    Dim ex As UIAutomationClient.IUIAutomationExpandCollapsePattern
                    Set ex = item.GetCurrentPattern(UIA_PatternIds.UIA_ExpandCollapsePatternId)
                    If (expand) Then
                        ex.expand
                    Else
                        ex.Collapse
                    End If
        
                End If
            End If
        Next
        
        p.name = name
    End Sub


    個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

    • 回答としてマーク u793nabe 2018年3月5日 21:18
    2018年3月5日 5:57
  • gekkaさん、大変お世話になっております。

    試行成功。早速活用させていただきます。どうも有難うございました。


    u793nabe

    2018年3月5日 21:18