VBA for OpenSelectionFile

Option Explicit

Sub 行非表示()
   'Rows.RowHeight = 18.75
   Dim va As Variant, ro As Range
   Dim words As Variant
   words = Array("aa", "ab")
   For Each va In words
      Set ro = Cells.Find(va, , , xlWhole, xlByColumns).EntireRow
      ro.Hidden = True
   Next
End Sub
Sub 行再表示()
    Rows.EntireRow.Hidden = False
End Sub
Function GetBtnCaller() As Button
   Dim sp As Shape
   Set sp = ActiveSheet.Shapes(Application.Caller)
   sp.Select
   Set GetBtnCaller = Selection
End Function
Sub 行追加()
   Dim i As Integer, ceBuf As Range
   Dim flag1 As Boolean, flag2 As Boolean
   Dim txtBtn As String, strFind As String, ceFind As Range
   Dim rgCopy As Range
   行再表示
   行非表示

   txtBtn = GetBtnCaller.Characters.Text
   
   strFind = Mid(txtBtn, InStr(txtBtn, " ") + 1)
   Set ceFind = Cells.Find(strFind, , , xlWhole, xlByColumns)
   
   For i = 1 To 100
      Set ceBuf = ceFind.Offset(0, i)
      If ceBuf.Borders(xlEdgeTop).LineStyle = xlNone Then
         Exit For
      End If
   Next
   Set rgCopy = Range(ceFind.Offset(0, 1), ceBuf.Offset(0, -1))
   
   For i = 1 To 100
      Set ceBuf = ceFind.Offset(i, 1)
      If ceBuf.Borders(xlEdgeLeft).LineStyle = xlNone Then
         flag1 = True
      End If
      If flag1 = True And ceBuf.Borders(xlEdgeLeft).LineStyle <> xlNone Then
         flag2 = True
      End If
      If flag2 = True And ceBuf.Borders(xlEdgeLeft).LineStyle = xlNone Then
         Exit For
      End If
   Next
   
   rgCopy.Copy ceBuf
   ceBuf.Select
   
End Sub

Sub OpenSelectionFile()
   Dim va As Variant
   Dim sIn As String, pathSerch As String, fullFi As String
   Dim ceFol As Range
   sIn = Selection.Value
   If sIn = "" Then Exit Sub
   Set ceFol = Cells.Find("Folder", , , xlWhole).Offset(0, 1)
   pathSerch = GetPathDesktop & "\" & ceFol.Value
   fullFi = pathSerch & "\" & "*" & sIn & "*"
   
   Dim ListFiles() As String
   ListFiles = GetFilesList(pathSerch, ("*" & sIn & "*"))
   
   Call ArySortByS(ListFiles)
   Dim nmOpen As String
   
   nmOpen = ListFiles(UBound(ListFiles))
   fullFi = pathSerch & "\" & nmOpen
   Call OpenOtherApp(fullFi)
   
End Sub
Public Function GetPathDesktop()
    Dim WSH As Object
    Set WSH = CreateObject("Wscript.Shell")
    Dim PathTop As String
    PathTop = WSH.SpecialFolders("Desktop")
    Set WSH = Nothing
    GetPathDesktop = PathTop
End Function
Public Sub ArySortByS(ByRef ary() As String)
    Dim i, j As Byte
    Dim judg As Integer
    Dim buf As String
    
    For j = 0 To UBound(ary)
    For i = 1 To UBound(ary) - 1 - j
        judg = StrComp(ary(i), ary(i + 1), vbTextCompare)
        If judg = 1 Then    'str1がstr2より大きい
            buf = ary(i + 1)
            ary(i + 1) = ary(i)
            ary(i) = buf
        End If
    Next
    Next
End Sub
Sub OpenOtherApp(fiFull As String)
    CreateObject("Wscript.Shell").Run """" & fiFull & """"
End Sub
Public Function GetFilesList(pathFolder As String, Optional nmPattern1 As String = "" _
        , Optional nmPattern2 As String = "", Optional nmPattern3 As String = "") As String()
   Dim n, p As Integer
   ReDim aryList(0) As String
   Dim patterns As Variant
   patterns = Array(nmPattern1, nmPattern2, nmPattern3)
   
   n = 0
   For p = LBound(patterns) To UBound(patterns)
     If patterns(p) <> "" Then
       aryList(n) = Dir(pathFolder & "\" & patterns(p))
       Do While Len(aryList(n)) > 0
           n = n + 1
           ReDim Preserve aryList(0 To n)
           aryList(n) = Dir()
       Loop
     End If
   Next
   ReDim Preserve aryList(0 To n - 1)
   GetFilesList = aryList
End Function