SSブログ

今日の日付の行だけ入力出来るようにする実験 Excel2000 VBA [Excel2000 VBA独習]

今日の日付の行だけ入力出来るようにする実験

前記事のつづき

今日の日付がある行を調べ、それ以外の行を選択したら選択していたセルに移動する。
選択セルに数式が設定されていれば、右に移動する。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   On Error Resume Next
   Dim scope As Range
   Dim today_row As Long
'今日の日付行
   today_row = ActiveSheet.Cells.Find(Date).Row
'入力許可範囲の設定
   Set scope = Range(Cells(today_row, 2), Cells(today_row, 255))
'選択セル判定
   With Application
      If .Intersect(Target, scope) Is Nothing _
      Then
         .EnableEvents = False
         .PreviousSelections(1).Select  '選択していたセルを選択
         .EnableEvents = True
      Else
         .Goto ActiveCell
      End If
   End With
'数式セルは選択出来ないようにする(数式ならば右移動)
If Target.HasFormula = True Then Target.Offset(0, 1).Select
'セットの解除
   Set scope = Nothing
End Sub
 

今日の日付がない場合の対処あり実験

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   On Error Resume Next
   Dim scope As Range
   Dim today_row As Long
'今日の日付行
   today_row = ActiveSheet.Cells.Find(Date).Row
   '今日の日付が無ければ
   If today_row < 1 Then GoTo owari
     
'入力許可範囲の設定
   Set scope = Range(Cells(today_row, 2), Cells(today_row, 255))
'選択セル判定
   With Application
      If .Intersect(Target, scope) Is Nothing _
      Then
         .EnableEvents = False
         .PreviousSelections(1).Select  'Cells(today_row, 2).Select
         .EnableEvents = True
      Else
         .Goto ActiveCell
      End If
   End With
'数式セルは選択出来ないようにする(数式ならば右移動)
If Target.HasFormula = True Then Target.Offset(0, 1).Select
'セットの解除
   Set scope = Nothing
Exit Sub
owari:
Application.EnableEvents = False
   MsgBox "今日の日付に該当するセルがありません。" & vbLf + vbLf & "シートイベントを無効にしました。"
End Sub


タグ:Excel2000 VBA
nice!(0)  コメント(0)  トラックバック(0) 
共通テーマ:パソコン・インターネット

nice! 0

コメント 0

コメントを書く

お名前:
URL:
コメント:
画像認証:
下の画像に表示されている文字を入力してください。

トラックバック 0

この広告は前回の更新から一定期間経過したブログに表示されています。更新すると自動で解除されます。