Sub 右矢印検索_次行に表示()
Dim start_row(100) As Integer
Dim start_col(100) As Integer
Dim end_row(100) As Integer
Dim end_col(100) As Integer
Dim Shp As Shape
Dim Ran As Range
Dim RowCell, point As Integer
Dim strRow, strCol, endRow, endCol As Integer
Dim shpwidth As Integer
point = 0
'********************************************************
'矢印検索
'********************************************************
For RowCell = 1 To Range("A65536").End(xlUp).Row
Rows(RowCell).Select
For Each Shp In ActiveSheet.Shapes
If Shp.Type = msoAutoShape Then
shpwidth = Shp.Width
Set Ran = Range(Shp.TopLeftCell, Shp.BottomRightCell)
If Intersect(Ran, Selection) Is Nothing = False Then
point = point + 1
If InStr(Ran.address(False, False), ":") > 0 Then '複数セルがある場合
start_row(point) = Range(Left(Ran.address(False, False), InStr(Ran.address(False, False), ":") - 1)).Row
start_col(point) = Range(Left(Ran.address(False, False), InStr(Ran.address(False, False), ":") - 1)).Column
end_row(point) = Range(Right(Ran.address(False, False), InStr(Ran.address(False, False), ":") - 1)).Row
end_col(point) = Range(Right(Ran.address(False, False), InStr(Ran.address(False, False), ":") - 1)).Column
Else
start_row(point) = Range(Ran.address(False, False)).Row
start_col(point) = Range(Ran.address(False, False)).Column
end_row(point) = start_row(point)
end_col(point) = start_col(point)
End If
End If
End If
Next
Next
'********************************************************
'次行に矢印
'********************************************************
For RowCell = 1 To point
strRow = start_row(point)
strCol = start_col(point)
endRow = end_row(point)
endCol = end_col(point)
'Call 右矢印表示_NextRow(strRow, strCol, endRow, endCol)
Call 右矢印表示_NextRow(start_row(point), start_col(point), end_row(point), end_col(point), shpwidth)
Next
End Sub
Sub 右矢印表示_NextRow(strRow As Integer, strCol As Integer, endRow As Integer, endCol As Integer, shpwidth As Integer)
Dim Ran As Range
Set Ran = Range(Cells(strRow, strCol), Cells(endRow, endCol))
' With ActiveSheet.Shapes.AddConnector(msoConnectorStraight, Ran.Left, Ran.Top + Ran.Height / 2, Ran.Left + Ran.Width, Ran.Top + Ran.Height / 2).Line
With ActiveSheet.Shapes.AddConnector(msoConnectorStraight, Ran.Left, Ran.Top + Ran.Height / 2, Ran.Left + shpwidth, Ran.Top + Ran.Height / 2).Line
.ForeColor.RGB = vbBlack
.EndArrowheadStyle = 2
.Weight = 2
End With
End Sub
