***************************************************************
選択されているセルを取得する
※指定条件に合致していない場合はエラーを表示させ, Nothingになる
※用途：ユーザが選択しているデータに対して処理する場合に
取得対象に範囲やエリア数,セル数等の制限をチェックして取得
【引数】UserSel ：主にSelectionを指定する
Row_Min ：取得したい範囲の開始行
Row_Max ：取得したい範囲の終了行
Col_Min ：取得したい範囲の開始列
Col_Max ：取得したい範囲の終了列
Area_Max ：取得したいエリア数
Cell_Max ：取得したいセル数
Alert ：アラートを出すオプション
AlertHead ：アラートメッセージの頭出し
***************************************************************
Public Function fRange_Selection(UserSel As Variant, _
Optional Row_Min As Long = 0, Optional Row_Max As Long = 0, _
Optional Col_Min As Long = 0, Optional Col_Max As Long = 0, _
Optional Area_Max As Long = 1, Optional Cell_Max As Long = 0, _
Optional Alert As Boolean = True, Optional AlertHead As String = "データ") As Range
'+ 選択されているレンジを返す
Dim Range_Select As Range
Dim Row_T As Long
Dim Col_T As Long
Dim Cnt_Area As Long
Dim Cnt_Cell As Long
Dim ErrMsg As String
If TypeName(UserSel) <> "Range" Then
ErrMsg = "セルを選択してください"
GoTo Terminate
End If
'- 選択レンジをセット
Set Range_Select = UserSel
'- 該当レンジの各種情報を取得
With Range_Select
Dim Area As Range
Row_T = .Row
Col_T = .Column
For Each Area In .Areas
With Area
If Row_T > .Row Then
Row_T = .Row
End If
If Col_T > .Column Then
Col_T = .Column
End If
End With
Next
Cnt_Area = .Areas.Count
Cnt_Cell = .Cells.Count
End With
'- 行範囲
If 0 < Row_Min Then
If Row_T < Row_Min Then
ErrMsg = AlertHead & "行を選択してください"
GoTo Terminate
End If
End If
If 0 < Row_Max Then
If Row_Max < Row_T Then
ErrMsg = AlertHead & "行を選択してください"
GoTo Terminate
End If
End If
'- 列範囲
If 0 < Col_Min Then
If Col_T < Col_Min Then
ErrMsg = AlertHead & "列を選択してください"
GoTo Terminate
End If
End If
If 0 < Col_Max Then
If Col_Max < Col_T Then
ErrMsg = AlertHead & "列を選択してください"
GoTo Terminate
End If
End If
'- 選択エリア数
If 0 < Area_Max Then
If Area_Max < Cnt_Area Then
ErrMsg = "エリアは" & Area_Max & "箇所以内で選択してください"
GoTo Terminate
End If
End If
'- 選択セル数
If 0 < Cell_Max Then
If Cell_Max < Cnt_Cell Then
ErrMsg = "セルは" & Cell_Max & "箇所以内で選択してください"
GoTo Terminate
End If
End If
Set fRange_Selection = Range_Select
Terminate:
If Alert = True Then
If ErrMsg <> "" Then
Call MsgBox(ErrMsg, vbCritical)
End If
End If
Set Range_Select = Nothing
End Function