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