戻　る

Excel図書管理のカスタマイズ例



【カスタマイズ例　その３】

Cただし、メッセージは最新遅延日より７日以内とする。

D金曜日の１６時以降の貸出の返却予定日は、３日後の月曜日とする。

<変更する箇所>
userform3：貸出フォーム

○　userfrom3　：　Private Sub CommandButton5_Click() 

  '　−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−　2011/10/18　Add
            ' 当日が月〜木の場合　金曜日の場合は月曜日となる。（土曜日閉館の為）
            Dim Youbi As String
            Youbi = WeekdayName(Weekday(Format(Now(), "yyyy/mm/dd")))
            
            If Taimu >= "16:00" And Youbi <> "金曜日" Then
                    Taimu2 = "09:00"
                    TextBox13 = Format(Date + TextBox14.Value + 1, "yyyy/mm/dd") & " " & Taimu2
            End If
            If Taimu >= "16:00" And Youbi = "金曜日" Then
                    Taimu2 = "09:00"
                    TextBox13 = Format(Date + TextBox14.Value + 3, "yyyy/mm/dd") & " " & Taimu2
            End If
   '　−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−　2011/10/18　Add

※　 WeekdayName(Weekday(Format(Now(), "yyyy/mm/dd")))　は「火曜日」などと表示する。

○　userfrom3　：　Sub CommandButton1_Click()　'　表示ボタン

 If Toujitu - Henkyaku <= 7 Then
        atai = MsgBox("延滞履歴：" & Sheets("会員一覧").Range("h" & kg).Value & "(" & Kazu & ")" & vbclf & vbCrLf & _
          "本日年月日：" & Toujitu & "  　最新延滞日：" & Henkyaku & " " & vbCrLf _
        & " 当日−最新延滞日＝" & Toujitu - Henkyaku, vbCritical + vbAbortRetryIgnore, "【貸出できません。】")
        If atai = vbRetry Then UserForm_Initialize
        If atai = vbAbort Then
            UserForm_Initialize
            CommandButton2_Click
        End If
    Else　　'　else　以下をコメントアウトした。
    '     MsgBox "延滞履歴：" & Sheets("会員一覧").Range("h" & kg).Value & vbclf & vbCrLf & _
          "本日年月日：" & Toujitu & "  　最新延滞日：" & Henkyaku & " " & vbCrLf _
        & " 当日−最新延滞日＝" & Toujitu - Henkyaku, vbOKOnly, _
        "【貸出可能です。】"
        
    End If

■　ダウンロード　カスタマイズ例　その３



【カスタマイズ例　その２】

［目標］

@　貸出時に返却予定日は年月日時刻として記録。

A　返却時に、返却予定日を当日と判定し、超えている場合は、受付記録に返却日に×をつけて記録。
さらに、会員一覧にも、H列に×を追加し、I列に最新の延滞日を記録する。

B　貸出時に、会員一覧のH列とI列を当日と比較し、7日以内の場合は貸出できない旨のメッセージを表示する。
ただし、「無視」ボタン選択で、貸出操作は可能とした。（定義テスト不具合対応。）
過去に遅延がある人はその旨の表示のみを行い、貸出は通常通りできる。

<変更する箇所>
userform3：貸出フォーム
userform6：返却フォーム


（１）userform3：貸出フォーム

　Sub CommandButton1_Click()　' ●　表示ボタン

'　一番最後に、下記の構文を追加する。

　　　'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝2011/10/15　ｶｽﾀﾏｲｽﾞadd
'　会員一覧のH列（延滞記号=×が入力されている）を表示する。
'　会員一覧のI列を貸出日と比較し、7日以内であれば、メッセージを表示する。
Dim kg As Long '　会員一覧での貸出者の行
Dim Kazu As Integer

If TextBox1.Value = "" Then Exit Sub


kg = Sheets("会員一覧").Range("b2").Value
If Mid(Sheets("会員一覧").Range("h" & kg).Value, 1, 1) = "×" Or Sheets("会員一覧").Range("i" & kg).Value <> "" Then

Dim Henkyaku As Date ' 会員一覧のI列＝最新の延滞日
Dim Toujitu As Date '　貸出日当日
Dim atai As Integer ' msgboxの選択の値

' 貸出時の年月日を取得
Toujitu = Format(Date, "yyyy/m/d")
'　会員一覧の最新延滞日を取得
Henkyaku = Format(Sheets("会員一覧").Range("i" & kg).Value, "yyyy/m/d")
Kazu = Len(Sheets("会員一覧").Range("h" & kg).Value)

If Toujitu - Henkyaku <= 7 Then
atai = MsgBox("延滞履歴：" & Sheets("会員一覧").Range("h" & kg).Value & "(" & Kazu & ")" & vbclf & vbCrLf & _
"本日年月日：" & Toujitu & " 　最新延滞日：" & Henkyaku & " " & vbCrLf _
& " 当日−最新延滞日＝" & Toujitu - Henkyaku, vbCritical + vbAbortRetryIgnore, "【貸出できません。】")
If atai = vbRetry Then UserForm_Initialize
If atai = vbAbort Then
UserForm_Initialize
CommandButton2_Click
End If
Else
MsgBox "延滞履歴：" & Sheets("会員一覧").Range("h" & kg).Value & vbclf & vbCrLf & _
"本日年月日：" & Toujitu & " 　最新延滞日：" & Henkyaku & " " & vbCrLf _
& " 当日−最新延滞日＝" & Toujitu - Henkyaku, vbOKOnly, _
"【貸出可能です。】"

End If

End If
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝


（２）　userform6　返却フォームの
Private Sub CommandButton2_Click()　'　表示ボタン

構文の最後に以下を追加する。

' =============================================================- 20110901 ｶｽﾀﾏｲｽﾞ=1015転用
'
Dim Henkyaku As Date ' 返却予定日＝メモ欄
Dim Toujitu As Date
Dim Jikan As Date  ' 当日受付の時間
Dim Jikan2 As Date  '返却予定日（メモ欄）の時間
Dim Hantei2 As String

Hantei2 = ""

' 返却時の年月日と時刻を取得
Toujitu = Format(Date, "yyyy/m/d"): Jikan = Format(Time, "HH:mm")
'　返却予定日の年月日を取得　〜　事前にUserForm_Activateで、メモ欄に返却予定日を表示させておく。
If Me.TextBox9.Value = "" Then
    MsgBox "返却予定日が未定なので、遅延判定ができません!!", , "図書管理表のK列に値がありません。"
    UserForm_Activate
    ' TextBox1.SetFocus <- ここでは動作しない。
    Exit Sub
End If

Henkyaku = Format(Mid(Me.TextBox9.Value, 1, InStr(Me.TextBox9.Value, " ") - 1), "yyyy/m/d")
'　返却予定日の時刻を取得する
Jikan2 = Format(Mid(Me.TextBox9.Value, InStr(Me.TextBox9.Value, " ") + 1, Len(Me.TextBox9.Value)), "HH:mm")
' MsgBox "返却年月日" & Henkyaku & ":" & Jikan2 & "::" & "今時間:" & Toujitu & ":" & Jikan
If Toujitu > Henkyaku Then Hantei2 = "×"                        '　×が付くのは返却遅れ
If Toujitu = Henkyaku Then
    If Jikan >= "09:30" And Jikan <= "12:30" And Jikan2 <> "12:30" Then Hantei2 = "×"
    If Jikan >= "13:00" And Jikan <= "16:00" And Jikan2 <> "16:00" Then Hantei2 = "×"
    If Jikan >= "16:00" And Jikan2 <> "9:00" Then Hantei2 = "×"
End If

'　TextBox9.Value = TextBox9.Value & " " & Hantei2　<--　有効にするとエラーになる

If Hantei2 = "×" Then
    MsgBox "返却予定日：" & Henkyaku & "-" & Jikan2 & " 　本日は、" & Toujitu & "-" & Jikan & vbCrLf & _
        "判定＝" & Hantei2 & "(延滞)", , "遅延しています!!"
        
Else
    MsgBox "遅延はありません。", , "期日チェック"
End If

' =======================================================================================-
（３）　userform6の返却フォーム
Private Sub CommandButton4_Click()　'　返却受付

構文の途中に、下記の部分を追加する。　 20111015 ｶｽﾀﾏｲｽﾞ　追加　の部分のみ追加すること！ 

' =============================================================- 20110901 ｶｽﾀﾏｲｽﾞ　追加
'
Dim Henkyaku As Date ' 返却予定日＝メモ欄
Dim Toujitu As Date
Dim Jikan As Date  ' 当日受付の時間
Dim Jikan2 As Date  '返却予定日（メモ欄）の時間
Dim Hantei2 As String

' 返却時の年月日と時刻を取得
Toujitu = Format(Date, "yyyy/m/d"): Jikan = Format(Time, "HH:mm")
'　返却予定日の年月日を取得　〜　事前にUserForm_Activateで、メモ欄に返却予定日を表示させておく。
Henkyaku = Format(Mid(Me.TextBox9.Value, 1, InStr(Me.TextBox9.Value, " ") - 1), "yyyy/m/d")
'　返却予定日の時刻を取得する
Jikan2 = Format(Mid(Me.TextBox9.Value, InStr(Me.TextBox9.Value, " ") + 1, Len(Me.TextBox9.Value)), "HH:mm")
' MsgBox "返却年月日" & Henkyaku & ":" & Jikan2 & "::" & "今時間:" & Toujitu & ":" & Jikan
If Toujitu > Henkyaku Then Hantei2 = "×"                        '　×が付くのは返却遅れ
If Toujitu = Henkyaku Then
    If Jikan >= "09:30" And Jikan <= "12:30" And Jikan2 <> "12:30" Then Hantei2 = "×"
    If Jikan >= "13:00" And Jikan <= "16:00" And Jikan2 <> "16:00" Then Hantei2 = "×"
    If Jikan >= "16:00" And Jikan2 <> "9:00" Then Hantei2 = "×"
End If

TextBox9.Value = TextBox9.Value & " " & Hantei2
    
' =============================================================- 20111015 ｶｽﾀﾏｲｽﾞ　追加
 ' 延滞した場合は、会員一覧に記録を残す：H列は"×"を追加入力、I列は最新の延滞日を記録する。

If Hantei2 = "×" Then
    Dim kg As Long  ' Kaiinn_Gyou
    Dim Bangou As String ' 会員の番号
    kg = Sheets("図書管理表").Range("b2").Value
    Bangou = Sheets("図書管理表").Range("h" & kg).Value
    Sheets("会員一覧").Range("b1").Value = Bangou: kg = Sheets("会員一覧").Range("b2").Value

    Sheets("会員一覧").Range("h" & kg).Value = Sheets("会員一覧").Range("h" & kg).Value & Hantei2
    Sheets("会員一覧").Range("i" & kg).Value = Toujitu
    MsgBox "延滞を記録しました。" & "返却日：" & Henkyaku & "、　今日：" & Toujitu & " " & Jikan
    
End If

' ==================================================================================-

カスタマイズ例その２のダウンロード　：会員一覧のH列、I列により、貸出時のメッセージフォームが変わります。
　　　　　　　　　　　　　　　　　　　説明のxlsブックにて簡単に説明しています。

カスタマイズ例　その２は、以上。

【カスタマイズ例　その１】
条件（下記が実現するようにカスタマイズする））
　　　　　９：３０〜１２：３０　の間に貸出したら、貸出期限は１２：３０
　　　　１３：００〜１６：００　の間に貸出したら、貸出期限は１６：００
　　　　１６：００〜９：００　の間に貸出したら、貸出期限は翌日の９：００
注）　貸出期限を過ぎたら、評価を付け、貸出者の評価点が集計できること。


変更点
　　　　（１）Userform3＝貸出フォームで、貸出時間を取得・記録する。
　　　　　　　　　　　　　　　Commandbutton5_Click()　の一部変更。

　　　　（２）Userform6＝返却フォームで、返却時間を取得し、貸出時に記録した返却予定日（年月日＋時間）と比較し、
　　　　　　　　　　　　　　　上記条件を満たさない場合は、"返却予定日＋×"を受付記録シートに追加入力する。
　　　　　　　　　　　　　　　Commandbutton4_Click()　の一部とUserform_activate（）の一部を変更。

　　　　（３）返却日数の設定は、０（ｾﾞﾛ）日とする。（tableシートのＩ６セルの値を0にする。）

　　　　（４）図書管理表シートのＪ列：貸出日、Ｋ列：返却予定日をセルの書式設定〜ユーザー定義：　yyyy/m/d hh:mm:@ を設定する。

　　　　（５）受付記録シートのＡ列：受付年月日、Ｇ列：返却予定日も（４）と同様に書式設定する。

　　　　注）返却受付で、受付記録シートのメモ欄に、返却予定日と評価（遅れた場合のみ×）が入力されます。
　　　　　　評価を集計する場合は、返却のみを抽出すると、集計が簡単になると思います。

変更点（１）〜貸出フォームのプロシージャーの変更
貸出フォーム
　開発タブ〜VisualBasic〜フォームから、上記のUserform3をダブルクリックして表示させる。
　「表示」ボタンをダブルクリックすると、Commandbutton5_Click()のプロシージャーが表示される。

 
TextBox8 = Sheets("図書管理表").Range("a" & i).Value    '1
TextBox9 = Sheets("図書管理表").Range("b" & i).Text     '2
TextBox10 = Sheets("図書管理表").Range("c" & i).Text    '3
TextBox11 = Sheets("図書管理表").Range("e" & i).Text    '5
TextBox12 = Sheets("図書管理表").Range("j" & i).Text    '10
TextBox13 = Sheets("図書管理表").Range("k" & i).Text    '11 返却予定日
            
 TextBox14 = Sheets("table").Range("i6").Value   
 ' ==============================================================　'　20110903　ｶｽﾞﾀﾏｲｽﾞ ここから
           
 ' TextBox12 = Format(Date, "yyyy/mm/dd")   ' <-- 修正前　20110901　●
   TextBox12 = Format(Date, "yyyy/mm/dd") & " " & Format(Time, "hh:mm")
'　TextBox13 = Format(Date + TextBox14.Value, "yyyy/mm/dd")　' <-- 修正前　20110901　●
   Dim Taimu As Date ' 追加
   Dim Taimu2 As String
   Taimu = Format(Time, "hh:mm")
   If Taimu < "09:30" Then Taimu2 = "12:30"
   If Taimu >= "09:30" And Taimu <= "12:30" Then Taimu2 = "12:30"
   If Taimu > "12:30" And Taimu < "16:00" Then Taimu2 = "16:00"
   TextBox13 = Format(Date + TextBox14.Value, "yyyy/mm/dd") & " " & Taimu2
            
   If Taimu >= "16:00" Then
        Taimu2 = "09:00"
        TextBox13 = Format(Date + TextBox14.Value + 1, "yyyy/mm/dd") & " " & Taimu2
   End If
            
' ==================================================================　'　20110903　ｶｽﾞﾀﾏｲｽﾞ ここまで
 If Hantei = "無" Then CommandButton3.SetFocus            
 'Ver2.01より　M列は貸出可否として使う！

（略）

上記の「20110903　ｶｽﾞﾀﾏｲｽﾞ　ここから」と「20110903　ｶｽﾞﾀﾏｲｽﾞ　ここまで」の間の構文を上のように貼り付ける。


変更点（２）〜返却フォームのプロシージャーの変更
返却フォーム
　VBE画面にて、上のフォームを表示させて、まず、上図Userform_activate()で示している背景部をダブルクリックして、
　Userform_activate()を表示させる。


Private Sub UserForm_Activate()

Application.OnKey "~"
（略）

TextBox8.Text = ""
TextBox8.Value = Format(Date, "yyyy/mm/dd") & " " & Format(Time, "hh:mm") ' 返却日　20110901 変更
ListBox1.Clear

（略）

TextBox8.Value = で始まる文を上のようになるように貼り付ける。


次に、Commandbutton4_Click()の箇所をさがして、修正にはいる。

Private Sub CommandButton4_Click()
'　返却受付
（略）
If (TextBox1 = "" And TextBox2 = "") Or TextBox5 = "" Or i = 0 Then
MsgBox "必須項目（本の番号か、利用者番号）が未入力です。"
GoTo re
End If
' =============================================================- 20110903 ｶｽﾀﾏｲｽﾞ　追加：ココから
'
Dim Henkyaku As Date ' 返却予定日＝メモ欄
Dim Toujitu As Date
Dim Jikan As Date ' 当日受付の時間
Dim Jikan2 As Date '返却予定日（メモ欄）の時間
Dim Hantei As String

' 返却時の年月日と時刻を取得
Toujitu = Format(Date, "yyyy/m/d"): Jikan = Format(Time, "HH:mm")
'　返却予定日の年月日を取得　〜　事前にUserForm_Activateで、メモ欄に返却予定日を表示させておく。
Henkyaku = Format(Mid(Me.TextBox9.Value, 1, InStr(Me.TextBox9.Value, " ") - 1), "yyyy/m/d")
'　返却予定日の時刻を取得する
Jikan2 = Format(Mid(Me.TextBox9.Value, InStr(Me.TextBox9.Value, " ") + 1, Len(Me.TextBox9.Value)), "HH:mm")
' MsgBox "返却年月日" & Henkyaku & ":" & Jikan2 & "::" & "今時間:" & Toujitu & ":" & Jikan
If Toujitu > Henkyaku Then Hantei = "×"
If Toujitu = Henkyaku Then
If Jikan >= "09:30" And Jikan <= "12:30" And Jikan2 <> "12:30" Then Hantei = "×"
If Jikan >= "13:00" And Jikan <= "16:00" And Jikan2 <> "16:00" Then Hantei = "×"
If Jikan >= "16:00" And Jikan2 <> "9:00" Then Hantei = "×"
End If

TextBox9.Value = TextBox9.Value & " " & Hantei

' =============================================================- 20110903 ｶｽﾀﾏｲｽﾞ　追加：ココまで

i = 登録行
Sheets("図書管理表").Range("h" & i & ":" & "L" & i).ClearContents
（略）

上記点線で挟まれた部分を挿入貼り付けする。



［参考］

VB画面
　VisualAsicの画面
　
　表示〜プロジェクト　エクスプローラとプロパティウインドウを出しておくと
　便利です。





























修正したものをダウンロード　（カスタマイズ　その２）

戻　る