見出し画像
Photo by kan__ma

Excel　受領書入力フォーム

つよし

前回のおさらい

送付物の紛失の為に、営業所・支店での「受領確認」が必要なった。
そのため、管理部署で受領書のチェック体制を整える。

・台帳に受領日（営業所・支店、管理部署）を記入、フォローする。
・受領日入力を簡単にするため、入力フォームを作成する。

入力フォーム作成

Excel台帳に「営業所・支店受領日」「管理部受領日」を追加

受領日入力前

入力フォームで「受領日」入力後のイメージ

受領日入力後

入力フォーム　オブジェクト名設定

前回のフォームで「営業所・支店」項目もあったほうが良いので、
追加します。
そして、フォームの中のオブジェクトに名前を付けます。

入力フォームで入力した値をどのように台帳に反映させるか考えて、
ＶＢＡでプログラムを書いていきます。

入力フォームを表示してみます

Sub FormShow()
    U_InputForm.Show
End Sub

入力フォームで「送付連番」を入力すると、
台帳情報　　・営業所・支店
　　　　　　・送付物名
が表示されたら便利ですよね。

送付連番　　　：　”１”　のとき、
営業所・支店　：　東京支店
送付物名　　　：　商品Ａ書類
が表示されるようにする。

営業所・支店、送付物名の情報を取得するコードを書いていきます。
クラスモジュール（clsInpForm）

Sub AutoNo_ItemShow         '送付連番を入力→営業所・支店、送付物名表示'
    Dim SendNo As Long      '送付連番'
    With U_InputForm
        SendNo = .U_AutoNo_T.Value
        .U_BrchName_T.Value = SendBranch(SendNo)
        .U_Syohin_T.Value = SendProduct(SendNo)
    End With
End Sub
Function SendProduct(ByVal SendNo As Long)     '送付物名の取得'
    Dim StBk As Worksheet                      'ワークシート'
    Dim EndRow As Long                         '台帳の最終行'
    Set StBk = ThisWorkbook.Worksheets("台帳")
    On Error Resume Next
    
    With StBk
        EndRow = .Cells(Rows.Count, 1).End(xlUp).Row         ' 台帳の最終行'
        SendProduct = WorksheetFunction.VLookup(SendNo,.Range("A2:D" & EndRow),4,False)
    End With
End Function
Function SendBranch(ByVal SendNo As Long)        '営業所・支店の取得'
    Dim StBk As Worksheet                        'ワークシート'
    Dim EndRow As Long                           '台帳の最終行'
    Set StBk = ThisWorkbook.Worksheets("台帳")
    On Error Resume Next
    
    With StBk
        EndRow = .Cells(Rows.Count, 1).End(xlUp).Row      ' 台帳の最終行'
        SendBranch = WorksheetFunction.VLookup(SendNo,.Range("A2:C" & EndRow),3,False)
    End With
End Function

ユーザーフォームを「コードの表示」して、
コードを書いていきます。

Private clsFrm As New clsInpForm

Private Sub U_AutoNo_T_AfterUpdate()
    clsFrm.AutoNo_ItemShow
End Sub
「送付連番」に”１”を入力したとき

ちゃんと表示されました。

では、受領日の入力について、考えてみます。
日付入力で「１０月２日」を考えると、
「2022/10/2」を入力するようになります。

簡単に日付を入力するには、「041022」と入力したほうが、
入力は速く入力できそうです。

日付編集コードを書いていきます。
クラスモジュール（clsInpForm）

Function EdtDate(ByVal tgtDay As String)　As Date
    EdtDate = Left(tgtDay, 2) + 2018 & "/" & Mid(tgtDay, 3, 2) & "/" & Right(tgtDay, 2)
End Function

入力フォームで項目入力が完了し、台帳に書込みしていきます。
クラスモジュール（clsInpForm）

Public Sub WrtStBkDate()            '台帳に書込'
    Dim StBk As Worksheet           'ワークシート'
    Dim SendNo As String            '送付連番'
    Dim BrchRptDate As Date         '営業所・支店受領日'
    Dim KanriRptDate As Date        '管理部受領日'
    
    Set StBk = ThisWorkbook.Worksheets("台帳")
     
    With U_InputForm
        SendNo = .U_AutoNo_T.Text
        BrchRptDate = EdtDate(.U_BrchDay_T.Text)
        KanriRptDate = EdtDate(.U_KnriDay_T.Text)
    End With
    
    With StBk
        If WorksheetFunction.CountIfs(.Range("A:A"), SendNo) > 0 Then
            Set findNo = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Find(SendNo)  '送付連番検索'
            If Not findNo Is Nothing Then
                firstadd = findNo.Address
                Do
                    .Range(findNo.Address).Offset(0, 4).Value = BrchRptDate                 '営業所・支店受領日書込'
                    .Range(findNo.Address).Offset(0, 5).Value = KanriRptDate                '管理部受領日書込'
                   
                    Set findNo = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row).FindNext(findNo)
                Loop While findNo.Address <> firstadd
            End If
        Else
            MsgBox "入力した送付連番はありませんでした!", vbCritical + vbInformation        '入力した送付連番がない時'
       End If
    End With
End Sub

ユーザーフォームにコードを書いていきます。

Private Sub U_Ok_B_Click()
   clsFrm.WrtStBkDate
End Sub

では、実行してみましょう。
送付連番を”3”入力していきます。

Okボタンを押すと、台帳の送付連番”3”の行に日付が記入されます。

ちゃんと実行されました。

このようにユーザーフォームを活用すると、
入力作業がスムーズに行えます。
今回のケースでは、1日に1件しかありませんが、
1日に１０，２０件あると、これは大変です。

ユーザーフォームの活用事例を紹介しました。
説明出来ていないコードもありますが、悪しからず。