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

2019年8月23日
2019年9月15日
販売管理システム【見積編】
VBA, エクセル

販売管理システム【見積編】

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

販売管理システムの作成をシリーズでお伝えしています。

前回までで見積書の自動作成に成功しました。

今回から、見積書を期間指定して作成する方法をご紹介します。

1 フォームを作っていこう
2 一括作成機能を作り込む
3 まとめ

フォームを作っていこう

期間指定する方法をご紹介する前に、システムっぽくするために入力フォームを作っていきましょう。

フォームの作り方は以下の記事で紹介しているので復習したい方は参考にしてください。

【ExcelVBA】ユーザーフォーム活用①

【ExcelVBA】ユーザーフォーム活用テクニック編【チェックボックス】

【ExcelVBA】ユーザーフォーム活用テクニック編【リストボックス】

【ExcelVBA】ユーザーフォーム活用テクニック編【スクロールバーについて】

【ExcelVBA】ユーザーフォーム活用【リストボックスから選択・メッセージボックス活用】

【ExcelVBA】ユーザーフォームを作りこむ【コンボボックスの使い方】

メインメニューと見積書作成フォームを作成する

まずメインメニューを作ります。フォームを作るときは、VBEを起動して挿入からユーザーフォームを選択します。

モジュール名はfrmMainmenuとします。

そして、下図のように各オブジェクトを配置し、オブジェクト名とCaptionを変更しておきましょう。

簡素なものですが、これから機能が増える度にオブジェクトを追加していきます。

②のフレームは初めて登場しましたが、簡単に言えばオブジェクトをひとかたまりとして考えるための枠組みととらえておけば良いと思います。

さらに、見積書作成フォームを作成します。

これでフォームは完成です。

シートにボタンを設置してフォームを起動してみよう

ボタンを配置する前に、標準モジュールに以下のようにコードを書きましょう。

Sub frmMainmenu_kidou()
    frmMainmenu.Show
End Sub

フォーム名＋showメソッドでフォームを起動できましたね。

コードが書けたら、シートにボタンを配置します。

「入力フォーム」シートを用意して、開発タブから挿入を選択し、ボタンを配置します。ボタン名はメインメニュー起動としました。

配置したボタンをクリックしてメインメニューが起動できたら成功です。

２つのフォームを組み合わせよう

上記で作った２つのフォームを連結させてみましょう。

cmbMsakuseiのクリックイベントプロシージャを生成します。

そのプロシージャに以下のようにコードを記述しましょう。

Private Sub cmbMsakusei_Click()
    frmMitumori.Show
End Sub

これで２つのフォームを連結でき見積書作成フォームを起動させることができました。

一括作成機能を作り込む

フォーム作成はこのくらいにして、次は一括作成機能を作り込んでいきます。

一括作成機能は前回までに作成した見積書作成の仕組みのことです。

一括作成ボタンから見積作成を可能にする

前回までに書いたコードを一括作成ボタンのクリックイベントプロシージャ（Private Sub cmbMikkatu_Click()）に転記してしまいましょう。

Private Sub cmbMikkatu_Click()
    Dim gyoA
    Dim gyo
    Dim tokuisakiGyo
    gyo = 2
    For gyoA = 2 To 7
        If Sheets("見積データ一覧").Range("A" & gyoA).Value <> Sheets("見積データ一覧").Range("A" & gyoA + 1).Value Then
            Sheets("見積書(元)").Copy after:=Sheets(Sheets.Count)
            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("A" & gyo).Value
            ActiveSheet.Range("H4").Value = Sheets("見積データ一覧").Range("B" & gyo).Value
            ActiveSheet.Range("G38").Value = Sheets("見積データ一覧").Range("L" & gyo).Value
            ActiveSheet.Range("B16:G" & gyoA - gyo + 16).Value = Sheets("見積データ一覧").Range("D" & gyo & ":I" & gyoA).Value 
            
             For tokuisakiGyo = 2 To 7
                If Sheets("得意先一覧").Range("B" & tokuisakiGyo).Value = Sheets("見積データ一覧").Range("C" & gyo).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
         
            gyo = gyoA + 1
        End If
    Next
End Sub

一括作成ボタンをクリックして見積書がエラーなく作成されていればOKです。

コードをカスタマイズする

このままでも見積書は作れるのですが、何点かカスタマイズしておきましょう。

作り込むとキリがないのですが、大事な部分を中心に以下のようにカスタマイズしていきます。

見積書を作成する場合に確認画面を出す
作った見積書シートに名前を付ける
同じ名前のシートがあったら処理を中止する
作成済みの見積書のログをとる
シート削除機能の実装

先にカスタマイズ済みのコードを紹介しますので、先ほどのコードに上書きしてしまいましょう。

Private Sub cmbMikkatu_Click()
    Dim gyoA
    Dim gyo
    Dim tokuisakiGyo
    
    Dim msg
    Dim title
    msg = "作成します。よろしいですか？"
    title = "確認"
    Dim res
    res = MsgBox(msg, vbYesNo + vbInformation, title)
    If res = vbNo Then
        Exit Sub
    End If
    
    gyo = 2
    For gyoA = 2 To Sheets("見積データ一覧").Range("A" & Rows.Count).End(xlUp).Row
        If Sheets("見積データ一覧").Range("A" & gyoA).Value <> Sheets("見積データ一覧").Range("A" & gyoA + 1).Value Then
            
            Dim sName As Worksheet
            For Each sName In Worksheets
                If sName.Name = Sheets("見積データ一覧").Range("A" & gyoA).Value & "_" & Sheets("見積データ一覧").Range("C" & gyoA).Value Then
                    MsgBox "シートが重複しています。処理を中断します。"
                    Exit Sub
                Else
                    
                End If
            Next
            Sheets("見積書(元)").Copy after:=Sheets(Sheets.Count)
            ActiveSheet.Name = Sheets("見積データ一覧").Range("A" & gyoA).Value & "_" & Sheets("見積データ一覧").Range("C" & gyoA).Value
            
            Dim sNameLrow
            sNameLrow = Sheets("入力フォーム").Range("B" & Rows.Count).End(xlUp).Row + 1 '入力フォームシートの最終行取得
            Sheets("入力フォーム").Range("B" & sNameLrow).Value = Sheets("見積データ一覧").Range("A" & gyoA).Value & "_" & Sheets("見積データ一覧").Range("C" & gyoA).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("A" & gyo).Value
            ActiveSheet.Range("H4").Value = Sheets("見積データ一覧").Range("B" & gyo).Value
            ActiveSheet.Range("G38").Value = Sheets("見積データ一覧").Range("L" & gyo).Value
            ActiveSheet.Range("B16:G" & gyoA - gyo + 16).Value = Sheets("見積データ一覧").Range("D" & gyo & ":I" & gyoA).Value
            
             For tokuisakiGyo = 2 To Sheets("得意先一覧").Range("A" & Rows.Count).End(xlUp).Row
                If Sheets("得意先一覧").Range("B" & tokuisakiGyo).Value = Sheets("見積データ一覧").Range("C" & gyo).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
            gyo = gyoA + 1
        End If
    Next
    Sheets("入力フォーム").Activate
End Sub

見積書を作成する場合に確認画面を出す

まず、一括作成する際に本当に作成して良いか確認のメッセージが出るようにしましょう。

コードの対象は６～１４行目になります。その部分だけ抜粋します。

    Dim msg
    Dim title
    msg = "作成します。よろしいですか？"
    title = "確認"
    Dim res
    res = MsgBox(msg, vbYesNo + vbInformation, title)
    If res = vbNo Then
        Exit Sub
    End If

変数msgとtitleに文言を格納しておき、メッセージボックスにその文言を表示させvbYesNoでユーザーに確認を促します。

もし、答えがいいえ（vbNo)だったらExitSubでコードを終了します。

メッセージボックスについてはこちらの記事で詳しく解説していますのでよかったらご覧ください。

上図のようにアクションが起これば成功です。

作った見積書シートに名前を付ける

現状だと作成された見積書のシート名は「見積書(元)(2)・見積書(元)(3)」のようになっているはずです。

これでは、シートを見ただけでは内容が分かりませんね。

そこで、シートに名前を付けます。

これは簡単です。コード３０行目を追加すればOKです。

ActiveSheet.Name = Sheets("見積データ一覧").Range("A" & gyoA).Value & "_" & Sheets("見積データ一覧").Range("C" & gyoA).Value

見積ナンバーと会社名を「＿」でつないだ文字列をシート名としています。

コードを実行して以下のようにシート名が変更されていれば成功です。

同じ名前のシートがあったら処理を中止する

シート名を変更できるようになると不具合も生じます。

それは、同じ名前のシートは作れない、ということです。

試しに、一括作成ボタンを連続でクリックしてみましょう。

すると以下のようにエクセルに怒られます。

エクセルでは同一ファイルに同一名のシートは作れないのでエラーになってしまいます。

これを解消していきましょう。

２０～２８行目が問題解決のコードです。

            Dim sName As Worksheet
            For Each sName In Worksheets
                If sName.Name = Sheets("見積データ一覧").Range("A" & gyoA).Value & "_" & Sheets("見積データ一覧").Range("C" & gyoA).Value Then
                    MsgBox "シートが重複しています。処理を中断します。"
                    Exit Sub
                Else

                End If
            Next

Sheetオブジェクトの名前をForEach構文で順次取得し、これから作ろうとしているシート名と既存のシート名が重複していないか確認しています。

重複したシートがあればメッセージボックスで注意を促し、ExitSubで処理を中止します。

上図のようにメッセージが出て処理が中断すればOKです。

このように予想される不具合は今のうちに防いでおきましょう。

作成済みの見積書のログをとる

どのデータでも同じことが言えますが、履歴をとっておくことは非常に重要です。

今回は作成した見積書のシート名と作成日時の履歴を入力フォームシートに転記します。

入力フォームシートのB７セルにシート名、C７セルに作成日時を記載しておきます。

コードは３２から３５行目になります。

 Dim sNameLrow
 sNameLrow = Sheets("入力フォーム").Range("B" & Rows.Count).End(xlUp).Row + 1 '入力フォームシートの最終行取得
 Sheets("入力フォーム").Range("B" & sNameLrow).Value = Sheets("見積データ一覧").Range("A" & gyoA).Value & "_" & Sheets("見積データ一覧").Range("C" & gyoA).Value
 Sheets("入力フォーム").Range("C" & sNameLrow).Value = Now

まず、入力フォームシートのB列最終行にプラス１した値を変数sNameLrowに格納します。

次に作成したシート名をB列に、作成日時（Now）をC列に記載しています。

こうすることによって、いつ何を作ったか自動で履歴が残るようになり、管理面で役立ちます。

当然、作成者情報などを履歴で残すことも可能なので、興味がある方は試しにチャレンジしてみましょう。

成功すると以下のように表示されます。

シート削除機能を実装する

ここで見積書を削除する機能も作っておきましょう。

いろいろ方法はあるかと思いますが、今回は以下のようにコードを書いてみました。

修正・削除ボタンに機能を実装します。

Private Sub cmbMsyusei_Click()
    Application.DisplayAlerts = False
    Dim sCnt
    For sCnt = Sheets.Count To 9 Step -1
        Sheets(sCnt).Delete
    Next
    Application.DisplayAlerts = True
End Sub

Application.DisplayAlerts = Falseでシートを削除する際にアラートが発生しないようにします。

ForNext構文で一枚ずつ削除しますが、Sheets.Countでファイル内のシート数を数えて９枚目まで削除します。

step-1をすることで、ファイルの最後尾から削除することが肝です。通常の昇順で処理してしまうとエラーになってしまいますので気を付けましょう。

９枚目というのは、たまたま僕が使っているファイルの見積書を除いたシート数が８枚だったため、９枚目まで削除すると見積書がすべて消えるということになるので、そのように設定しました。

詳しい削除機能の実装はゆくゆくご紹介していく予定なので、今回は、簡易的なものにとどめておきます。