tmp

涼マクロ - Google ドライブ

出勤打刻マクロ

'勤務表を開かずに打刻できるマクロ(出勤ver.)

'このサブプロシージャを他モジュールから呼び出せないようにする
Private Sub Workbook_Open()
    
    Dim RefPath As String '文字列型の変数(=share勤務表が格納されているフォルダパス)を宣言
    Dim RefWb As Workbook 'ワークブック型のオブジェクト(=share勤務表のファイルオブジェクト)を宣言
    Dim sht As Worksheet 'ワークシート型のオブジェクト(=現在の月)を宣言
    
    Dim currentMonth As Long '整数型の変数(=現在の月)を宣言
    Dim currentDay As Long '整数型の変数(=現在の日)を宣言
    Dim currentHour As Long '整数型の変数(=現在の時)を宣言
    Dim currentMinute As Long '整数型の変数(=現在の分)を宣言
    
    Dim nRow As Long '整数型の変数(=月初から月末までの入力行のカウンター)を宣言
    
    currentMonth = Month(Now())
    currentDay = Day(Now())
    currentHour = Hour(Now())
    currentMinute = Minute(Now())
    
    RefPath = "C:\Users\mtkbirdman\Desktop\涼マクロ" 'share勤務表が格納されているフォルダパス
    Set RefWb = Workbooks.Open(Filename:=RefPath & "\勤務表_沖本.xlsx", Password:="0908") 'RefWbに関数の戻り値(share勤務表のファイルオブジェクト)を格納する、開いてもいる
    
    With RefWb '省略用
    
        Set sht = .Worksheets(currentMonth & "月") 'shtに関数の戻り値(○月)を格納
        
        For nRow = 3 To 34 '月初から月末までの入力行のループを開始
            If sht.Cells(nRow, 2) = currentMonth & "月" & currentDay & "日" Then 'もしもB3~B34セルの値が現在の月日と一致しているなら
                sht.Cells(nRow, 3) = currentHour '出勤時刻(時)を入力
                sht.Cells(nRow, 5) = currentMinute '出勤時刻(分)を入力
            End If
        Next nRow
        
        .Save 'share勤務表のファイルオブジェクトを保存
        .Close 'share勤務表のファイルオブジェクトを閉じる
    
    End With '省略適用ここまで
    
    'メッセージボックスに出勤時刻と励ましを表示
    MsgBox currentMonth & "月" & currentDay & "日 " & currentHour & ":" & currentMinute & _
            vbCrLf & "今日も出勤してえらい"
    
End Sub
Sub 出勤打刻()

    Dim RefPath As String '文字列型の変数(=share勤務表が格納されているフォルダパス)を宣言
    Dim RefWb As Workbook 'ワークブック型のオブジェクト(=share勤務表のファイルオブジェクト)を宣言
    Dim sht As Worksheet 'ワークシート型のオブジェクト(=現在の月)を宣言
    
    Dim currentMonth As Long '整数型の変数(=現在の月)を宣言
    Dim currentDay As Long '整数型の変数(=現在の日)を宣言
    Dim currentHour As Long '整数型の変数(=現在の時)を宣言
    Dim currentMinute As Long '整数型の変数(=現在の分)を宣言
    
    Dim nRow As Long '整数型の変数(=月初から月末までの入力行のカウンター)を宣言
    
    currentMonth = Month(Now())
    currentDay = Day(Now())
    currentHour = Hour(Now())
    currentMinute = Minute(Now())
    
    RefPath = "C:\Users\mtkbirdman\Desktop\涼マクロ" 'share勤務表が格納されているフォルダパス
    Set RefWb = Workbooks.Open(Filename:=RefPath & "\勤務表_沖本.xlsx", Password:="0908") 'RefWbに関数の戻り値(share勤務表のファイルオブジェクト)を格納する、開いてもいる
    
    With RefWb '省略用
    
        Set sht = .Worksheets(currentMonth & "月") 'shtに関数の戻り値(○月)を格納
        
        For nRow = 3 To 34 '月初から月末までの入力行のループを開始
            If sht.Cells(nRow, 2) = currentMonth & "月" & currentDay & "日" Then 'もしもB3~B34セルの値が現在の月日と一致しているなら
                sht.Cells(nRow, 3) = currentHour '出勤時刻(時)を入力
                sht.Cells(nRow, 5) = currentMinute '出勤時刻(分)を入力
            End If
        Next nRow
        
        .Save 'share勤務表のファイルオブジェクトを保存
        .Close 'share勤務表のファイルオブジェクトを閉じる
    
    End With '省略適用ここまで
    
    'メッセージボックスに出勤時刻と励ましを表示
    MsgBox currentMonth & "月" & currentDay & "日 " & currentHour & ":" & currentMinute & _
            vbCrLf & "今日も出勤してえらい"
    
End Sub
質問・感想・意見などあれば気軽にTwitterのDMかコメントお願いします!
スポンサーリンク