ライブラリ

fRange_Selection

***************************************************************
選択されているセルを取得する
※指定条件に合致していない場合はエラーを表示させ, 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
 

Range   2017/11/21   shono

この記事へのコメント

コメントを送る

 
※ メールは公開されません
Loading...
 画像の文字を入力してください