header

時刻の記録を考える (6)

できた日報から、特定の日(セルF2の値)の出退勤をグラフにします。
最後のシート("Sheet3")の列幅を狭くして該当時間を塗りつぶします。
プログラムは、Sheet2に入れます。
特定の日付にする。
' Sheet2 にボタンを加えて次を動作させます。セルF2に当月の日付があること。
    Sub sagasu()
    	tukidays = 30	' 仮に設定
    	Worksheets("sheet2").Activate
    	sore = Worksheets("sheet2").Range("f2").Value	' 特定の日
    	If sore > tukidays Then
        	MsgBox "日にちが合いませんので終了します。"
        	Exit Sub
    	End If
    
    	For i = 7 To 180 Step 5
        	cnt = cnt + 1
        	If cnt = sore Then
            	Cells(9, i).Select
            	Exit For
        	End If
    	Next i
    	thatday = i
    	makeretu			' 幅を設定します。
    End Sub

シート3にグラフ用のセルの幅を設定する。
    Sub makeretu()
	    Worksheets(4).Columns("b:ea").ColumnWidth = 0.3
	    Worksheets(4).Range("b2:b5").Borders(xlEdgeLeft).LineStyle = xlContinuous
	    Worksheets(4).Range("b2:b5").Borders(xlEdgeLeft).Color = 255
	    
	    For g = 11 To 13		' 3名限定
	        gyou = g
	        onamae = Worksheets(3).Cells(g, 3).Value
	        MsgBox onamae & "さんの就労です。"
	        If Not Worksheets(3).Cells(g, thatday).Value = "" Then
	        	intime = Worksheets(3).Cells(g, thatday).Value	' Date変数です
	            intimestr = CStr(intime)			' String変数です
	            mazu (intimestr)			' 出勤時刻を送ります(スタートの時刻)
	        End If
	        If Not Worksheets(3).Cells(g, thatday + 1).Value = "" Then
	            outtime = Worksheets(3).Cells(g, thatday + 1).Value		' Date変数です
	            outtimestr = CStr(outtime)					' String変数です
	            Call tugini(outtimestr, gyou)	' 退勤時刻を送り(終了の時刻)、塗りつぶします。
	        End If
	    Next g
    End Sub

まず、出勤時刻を処理に回す。
    Sub mazu(ByVal sttime As String)  '受けた時刻(「8:12:00」)から時と分を取得する。
	    pos1 = 0
	    pos2 = 0
	    ji = 0
	    fun = 0
	    funmasu = 0
	    masu = 0
	    If Not sttime = "" Then
	        stratai = CDate(sttime)
	        pos1 = InStr(stratai, ":")				' 最初の位置
	        ji = Left(stratai, pos1 - 1)
	        stratai2 = Mid(stratai, pos1 + 1)
	        pos2 = InStr(stratai2, ":")     ' =3	次の位置
        	fun = Left(stratai2, pos2 - 1)
        	strlen = Len(stratai)
    	Else
        	MsgBox "ありません。"
    	End If
    
    	If ji = 0 Then		' 範囲指定します
        	If fun >= 1 And fun < 15 Then	
            	masu = 1
        	ElseIf fun >= 15 And fun < 30 Then		'>
            	masu = 2
        	ElseIf fun >= 30 And fun < 45 Then		'>
            	masu = 3
        	ElseIf fun >= 45 And fun < 60 Then		'>
            	masu = 4
        	End If
    	Else
        	If fun >= 1 And fun < 15 Then		'>
            	funmasu = 1
        	ElseIf fun >= 15 And fun < 30 Then		'>
            	funmasu = 2
        	ElseIf fun >= 30 And fun < 45 Then		'>
            	funmasu = 3
        	ElseIf fun >= 45 And fun < 60 Then		'>
            	funmasu = 4
        	ElseIf fun = 0 Then
            	funmasu = 1
        	Else
            	MsgBox " 中断します。 fun=" & fun
            	Exit Sub
        	End If
        	masu = 4 * ji + funmasu
    	End If
    	startmasu = masu
    End Sub

次に、退勤時刻を処理に回す。
そして、塗りつぶす。
    Sub tugini(ByVal entime As String, ByVal sonogyou As Integer)	' 退勤時刻です
	    pos1 = 0
	    pos2 = 0
	    ji = 0
	    fun = 0
	    funmasu = 0
	    masu = 0
		' 「:」の位置から時と分を取得    
	    If Not entime = "" Then
	        stratai = CDate(entime)
	        pos1 = InStr(stratai, ":")
	        ji = Left(stratai, pos1 - 1)
	        stratai2 = Mid(stratai, pos1 + 1)
	        pos2 = InStr(stratai2, ":")
	        fun = Left(stratai2, pos2 - 1)
	        strlen = Len(stratai)
	    Else
	        MsgBox "ありません。"
	    End If
    
	    If ji = 0 Then
	        If fun >= 1 And fun < 15 Then		'>
	            masu = 1
	        ElseIf fun >= 15 And fun < 30 Then		'>
	            masu = 2
	        ElseIf fun >= 30 And fun < 45 Then		'>
	            masu = 3
	        ElseIf fun >= 45 And fun < 60 Then		'>
	            masu = 4
	        End If
	    Else
	        If fun >= 1 And fun < 15 Then		'>
	            funmasu = 1
	        ElseIf fun >= 15 And fun < 30 Then		'>
    	        funmasu = 2
	        ElseIf fun >= 30 And fun < 45 Then		'>
	            funmasu = 3
	        ElseIf fun >= 45 And fun < 60 Then		'>
    	        funmasu = 4
	        ElseIf fun = 0 Then
	            funmasu = 1
	        Else
	            MsgBox " 中断します。 fun=" & fun
	            Exit Sub
	        End If
			masu = 4 * ji + funmasu	' 終了するマス番号になります
	    End If
	    endmasu = masu
	    Dim i As Integer
	    Worksheets(4).Cells(sonogyou, 1).Value = onamae
	    onamae = ""
	    For i = startmasu + 1 To endmasu + 1	' 塗りつぶします。
	        Worksheets(4).Cells(sonogyou, i).Interior.Color = RGB(255, 255, 63)
	    Next i
    End Sub

ファイルを読むために、FileSystemObjectを参照設定(メニューのツール)で登録しています。
「Micrsoft Scripting RunTime」にチェックする。

表記上、変数の宣言は省略しています。
エクセルの利用ページ(Top Page)へ
tsuingcom