【販売管理システム作成】見積書を期間指定して作成する方法③【リストボックス作成その2】

みなさん、こんにちはケンケンです。

 

販売管理システムをエクセルのみで作成することにチャレンジしています。

前回は、見積書を期間指定して作成する前段階としてフォームにデータを表示する方法をご紹介しました。

今回は、フォームにさらに機能を追加していきます。

それでは、以下ご覧ください。

 

前回の復習

前回は、以下のフォームを作成し、期間指定して検索ボタンをクリックススト、上のリストボックスにデータを表示することに成功しました。

前回書いたコードも以下に表示しておきます。

Private Sub UserForm_Initialize()
    With lstMitumori
        .ColumnCount = 3
        .ColumnWidths = "50;100;100"
        .TextAlign = fmTextAlignLeft
    End With
    
    With lstMeisai
        .ColumnCount = 7
        .ColumnWidths = "80;36;60;60;60;60;60"
        .TextAlign = fmTextAlignCenter
    End With
    
    btnCreat.Enabled = False
    btnUpdate.Enabled = False
End Sub

 

Private Sub btnKensaku_Click()
    If txtDay1.Text = "" Or txtDay2.Text = "" Then
        MsgBox "期間指定してください。", vbInformation
        Exit Sub
    End If
    
    Sheets("見積データ一覧").Activate
    Range("O2:P2").Value = ""
    Range("O2").Value = ">=" & txtDay1.Text
    Range("P2").Value = "<=" & txtDay2.Text
    Sheets("見積データ一覧").Range("A1:M7").AdvancedFilter Action:=xlFilterCopy, _
        criteriarange:=Range("O1:P2"), copytorange:=Range("O4:AA4"), Unique:=True
        
     With lstMitumori
        .Clear
        Dim Lrow
        Lrow = Sheets("見積データ一覧").Range("O" & Rows.Count).End(xlUp).Row
        Dim cnt
        For cnt = 5 To Lrow
            If Sheets("見積データ一覧").Range("O" & cnt).Value <> Sheets("見積データ一覧").Range("O" & cnt + 1).Value Then
                .AddItem Format(Range("O" & cnt).Value, "00000")
                .List(.ListCount - 1, 1) = Range("P" & cnt).Value
                .List(.ListCount - 1, 2) = Range("Q" & cnt).Value
            End If
        Next
     End With
     lstMeisai.Clear
End Sub

今回は、上のリストボックスからデータを選択すると、下のリストボックスに見積データの詳細が表示させたり、実際に見積書を作成できるようにします。

上のリストボックスを選択した場合の処理

ここでも前回使ったフィルタオプション機能を使っていきます。

アクションの順番としては、上のリストボックスの任意のデータをクリックすると詳細が下のリストボックスに反映されるように作ります。

それを実現するには、リストボックスのChangeイベントを使用します。

 

下のリストボックスに表示するコードを書こう

VBEの「見積情報検索」フォームにある上のリストボックスをダブルクリックして、lstMitumoriのChangeプロシージャを作成してください。

 

プロシージャにコードを書こう

Changeプロシージャを作れたら早速コードを書いていきましょう。

Private Sub lstMitumori_Change()
    Sheets("見積データ一覧").Activate '①
    Range("Q2").Value = "" '②
    Range("Q2").Value = lstMitumori.Value '③
    Sheets("見積データ一覧").Range("A1:M7").AdvancedFilter Action:=xlFilterCopy, _
        criteriarange:=Range("O1:Q2"), copytorange:=Range("O4:AA4") '④
        
     With lstMeisai '⑤
        .Clear '⑥
        Dim Lrow '⑦
        Lrow = Sheets("見積データ一覧").Range("O" & Rows.Count).End(xlUp).Row '⑦
        Dim cnt '⑧
        For cnt = 5 To Lrow '⑧
            .AddItem Range("R" & cnt).Value '⑧
            .List(.ListCount - 1, 1) = Range("T" & cnt).Value '⑧
            .List(.ListCount - 1, 2) = Range("U" & cnt).Value '⑧
            .List(.ListCount - 1, 3) = Format(Range("V" & cnt).Value, "#,###") '⑧
            .List(.ListCount - 1, 4) = Format(Range("W" & cnt).Value, "#,###") '⑧
            .List(.ListCount - 1, 5) = Format(Range("X" & cnt).Value, "#,###") '⑧
            .List(.ListCount - 1, 6) = Format(Range("AA" & cnt).Value, "#,###") '⑧
        Next
     End With
     
     btnCreat.Enabled = True '⑨
     btnUpdate.Enabled = True '⑨
End Sub

コード解説

コードを解説するにあたって参考まで以下に見積データ一覧シートの構成を今一度表示しておきます。

①フィルタオプションを使うために「見積データ一覧」シートをアクティブにしておく必要があります。

 

②検索範囲を一度クリアにします。

 

lstMitumori.Value=見積Noですね。この値をQ2セルに転記します。

 

④~⑧前回とほとんど同じコードなので説明は省きます。データの抽出からリストボックスへの転記までの一連の動きをとらえられるようにしてください。

 

前回選択不能にしていたボタンを選択可能に変更しています。

 

アクション確認

コードを理解できたら実行してみましょう。

フォームを開いて実際にデータを選択してみてください。

上図のように下のリストボックスに詳細が表示され、さらに左下2つのボタンが選択可能になったら成功です。

 

見積書作成ボタンをクリックしたときの処理

左下2つのボタンのうち見積書作成ボタンをクリックしたときの処理を作ります。

コードは一括処理を転用しよう

これから、見積書作成用のコードを書きますが、一度似たようなものを書きましたね。

そうです。一括作成用のコードです。これをコピーして加工したものが以下の通りです。

VBEからボタンをダブルクリックしてClickプロシージャを作成します。

Private Sub btnCreat_Click()
    Dim gyoA
    Dim tokuisakiGyo
    
    Dim msg
    Dim title
    msg = "作成します。よろしいですか?"
    title = "確認"
    Dim res
    res = MsgBox(msg, vbYesNo + vbInformation, title)
    If res = vbNo Then
        Exit Sub
    End If
    
    Dim Lrow
    Lrow = Sheets("見積データ一覧").Range("O" & Rows.Count).End(xlUp).Row
          
    Dim sName As Worksheet
    For Each sName In Worksheets
        If sName.Name = Sheets("見積データ一覧").Range("O5").Value & "_" & Sheets("見積データ一覧").Range("Q5").Value Then
            MsgBox "シートが重複しています。処理を中断します。"
            Exit Sub
        Else

        End If
    Next
        Sheets("見積書(元)").Copy after:=Sheets(Sheets.Count)
        ActiveSheet.Name = Sheets("見積データ一覧").Range("O5").Value & "_" & Sheets("見積データ一覧").Range("Q5").Value
        
        Dim sNameLrow
        sNameLrow = Sheets("入力フォーム").Range("B" & Rows.Count).End(xlUp).Row + 1 '入力フォームシートの最終行取得
        Sheets("入力フォーム").Range("B" & sNameLrow).Value = Sheets("見積データ一覧").Range("O5").Value & "_" & Sheets("見積データ一覧").Range("Q5").Value
        Sheets("入力フォーム").Range("C" & sNameLrow).Value = Now
        
        ActiveSheet.Range("F6").Value = Sheets("会社情報").Range("A2").Value
        ActiveSheet.Range("F7").Value = Sheets("会社情報").Range("B2").Value
        ActiveSheet.Range("G7").Value = Sheets("会社情報").Range("C2").Value
        ActiveSheet.Range("F8").Value = Sheets("会社情報").Range("D2").Value
        ActiveSheet.Range("F9").Value = "TEL " & Sheets("会社情報").Range("E2").Value & " :FAX " & Sheets("会社情報").Range("F2").Value
        ActiveSheet.Range("H3").Value = Sheets("見積データ一覧").Range("O5").Value
        ActiveSheet.Range("H4").Value = Sheets("見積データ一覧").Range("P5").Value
        ActiveSheet.Range("G38").Value = Sheets("見積データ一覧").Range("Z5").Value
        ActiveSheet.Range("B16:G" & Lrow - 5 + 16).Value = Sheets("見積データ一覧").Range("R5" & ":W" & Lrow).Value '①
        
        For tokuisakiGyo = 2 To Sheets("得意先一覧").Range("A" & Rows.Count).End(xlUp).Row
            If Sheets("得意先一覧").Range("B" & tokuisakiGyo).Value = Sheets("見積データ一覧").Range("Q5").Value Then
                Sheets("得意先貼付元").Range("B1").Value = "〒" & Sheets("得意先一覧").Range("C" & tokuisakiGyo).Value
                Sheets("得意先貼付元").Range("B2").Value = Sheets("得意先一覧").Range("D" & tokuisakiGyo).Value
                Sheets("得意先貼付元").Range("B3").Value = Sheets("得意先一覧").Range("E" & tokuisakiGyo).Value
                Sheets("得意先貼付元").Range("B4").Value = Sheets("得意先一覧").Range("B" & tokuisakiGyo).Value & " 御中"
                Sheets("得意先貼付元").Range("B1:B4").Copy
                ActiveSheet.Range("B2").Select
                ActiveSheet.Pictures.Paste.Select
            End If
        Next
End Sub

以前との相違点は、作成する見積書は1枚である、ということです。

なので、見積書を複数作成するための繰り返し処理と変数は削除しています。

ここら辺については、以前の記事をご覧になって変更点を確かめていただくと良いでしょう。

 

コード解説

①見積データ一覧から新たに作成された見積書へデータを転記するコードですが、変数LrowとRangeオブジェクトを使って転記する範囲を指定してるので参考にしてください。

 

アクション確認

それでは、実際に見積書作成ボタンをクリックして見積書を作成してみてください。

下図のようにできていれば成功です。

 

まとめ

期間指定からデータを抽出して見積書を作成することが出来ました。

だんだんとシステムっぽくなってきましたね。

次回は編集機能を作っていきましょう。

せっかくリストボックスにデータを転記できたので、その機能を生かしてさらにユーザーに使いやすいものにしていきますのでお楽しみに。

それではまた次回お会いしましょう。

 

販売管理システム作成記事一覧~見積編~

エクセルを駆使して販売管理システムを作ってみる【元データの取り扱い方】

【販売管理システム作成】見積書を自動作成する方法①

【販売管理システム作成】見積書を自動作成する方法②

【販売管理システム作成】見積書を期間指定して作成する方法①【コードのカスタマイズ】

【販売管理システム作成】見積書を期間指定して作成する方法②【リストボックス作成】

【販売管理システム作成】見積書を期間指定して作成する方法③【リストボックス作成その2】

【販売管理システム作成】見積データ登録用のフォームを作ろう①【フォームの設定】

【販売管理システム作成】見積データ登録用のフォームを作ろう②【コンボボックスの活用】

【販売管理システム作成】見積データ登録用のフォームを作ろう③【リストボックスの活用】

【販売管理システム作成】見積データ登録用のフォームを作ろう④【エクセルシートに登録】

【販売管理システム作成】見積データ登録用のフォームを作ろう⑤【修正削除機能の実装】

【販売管理システム作成】登録済みのデータを修正削除する方法【見積システム完成編】