[[20041119225019]]　『キーボードからの入力制限』（あっち）　ページの最後に飛ぶ

『キーボードからの入力制限』（あっち）

数日前にもお世話になりました。

自作のタイムカードをエクセルで作っています。

マクロで出勤、退勤の打刻を出来るようにしたいのですが、今現在は

　 a　　　b 　　　c 　　　d 　　　e

1 日付　曜日　出勤　退勤　勤務時間

2　 1 　　日

3　 2　　月

4 　3　　火

というシートの出勤、退勤をコマンドボタンで入力できるように

Sub 打刻()

    ActiveCell.FormulaR1C1 = "=NOW()"
    Selection.Copy
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
End Sub

としています。

日付と曜日はシルアル値になっています。

問題点１

時刻をコマンドボタン以外では入力制限をしたい（キーボードやできれば2度打刻）

問題点２

打刻場所をアクティブにしなくても適切な場所に入力したい

ちなみに勤務可能な時間は9：00から翌日5時です

可能でしょうか？アドバイスをよろしくお願いします。

 以下のような表があるとして、マクロでならこんな感じでどうでしょうか。
	 A	 B	 C	 D	 E
  1	日付	曜日	出勤	退勤	勤務時間
  2	11/14	日			
  3	11/15	月			
  4	11/16	火			
  5	11/17	水			
  6	11/18	木			
  7	11/19	金			
  8	11/20	土			
  9	11/21	日			
 10	11/22	月			
 11	11/23	火			
 12	11/24	水			
 13	11/25	木			
 14	11/26	金			
 15	11/27	土			
 16	11/28	日			
 17	11/29	月			
 18	11/30	火

 Option Explicit
Sub 打刻()
Dim SDate As Variant, EDate As Variant
Dim MyDate As Date
Dim MyRow As Long
Dim c As Range
Dim FindAddress As String
MyDate = Date
MyRow = Range("A65536").End(xlUp).Row
With Worksheets("Sheet1").Range("A2:A" & MyRow)
    Set c = .Find(MyDate, LookIn:=xlFormulas)
    If Not c Is Nothing Then
        FindAddress = c.Address
        SDate = Range(FindAddress).Offset(, 2).Value
        EDate = Range(FindAddress).Offset(, 3).Value
    Else
        MsgBox ("該当する日がありません")
        Exit Sub
    End If
End With
    If IsEmpty(SDate) = False And _
        IsEmpty(EDate) = False Then Exit Sub
        ActiveSheet.Unprotect
    If Range(FindAddress).Offset(, 2).Value = "" Then
        Range(FindAddress).Offset(, 2).Value = Format(Now, "hh:mm")
    Else
        Range(FindAddress).Offset(, 3).Value = Format(Now, "hh:mm")
　　End If
ActiveSheet.Protect
End Sub

 参考までにどうぞ。
http://skyblue123.hp.infoseek.co.jp/Excel/TimeCard.xls
 （川野鮎太郎）

 σ(^◇^;)もちょっと考えてみました。
今のトピ主さんのマクロはNOWをコピーして値の貼り付けで確定してるんですよね？
検索するんなら鮎ちゃんの方法がいいと思いますが、別案でダブルクリックはどうでしょうか？
指がつるかな？(^^;;;
まぁ、ご参考までにどうぞv(=∩_∩=)v
（SoulMan）
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("C2:D4")) Is Nothing Then Exit Sub
Cancel = True
Me.Protect , , , , True
If IsEmpty(Target.Value) Then
    Target.Value = Format(Now, "hh:mm")
End If
End Sub
http://ryusendo.no-ip.com/cgi-bin/upload/src/up0167.xls

コメント返信：

[ 一覧(最新更新順) ]

[[20041119225019]] 『キーボードからの入力制限』（あっち） ページの最後に飛ぶ

[[20041119225019]]　『キーボードからの入力制限』（あっち）　ページの最後に飛ぶ