みなさん、こんにちはケンケンです。
販売管理システムの作成をシリーズでお伝えしています。
前回までで見積書の自動作成に成功しました。
今回から、見積書を期間指定して作成する方法をご紹介します。
フォームを作っていこう
期間指定する方法をご紹介する前に、システムっぽくするために入力フォームを作っていきましょう。
フォームの作り方は以下の記事で紹介しているので復習したい方は参考にしてください。
【ExcelVBA】ユーザーフォーム活用テクニック編【チェックボックス】
【ExcelVBA】ユーザーフォーム活用テクニック編【リストボックス】
【ExcelVBA】ユーザーフォーム活用テクニック編【スクロールバーについて】
【ExcelVBA】ユーザーフォーム活用【リストボックスから選択・メッセージボックス活用】
【ExcelVBA】ユーザーフォームを作りこむ【コンボボックスの使い方】
メインメニューと見積書作成フォームを作成する
まずメインメニューを作ります。フォームを作るときは、VBEを起動して挿入からユーザーフォームを選択します。
モジュール名はfrmMainmenuとします。
そして、下図のように各オブジェクトを配置し、オブジェクト名とCaptionを変更しておきましょう。
簡素なものですが、これから機能が増える度にオブジェクトを追加していきます。
②のフレームは初めて登場しましたが、簡単に言えばオブジェクトをひとかたまりとして考えるための枠組みととらえておけば良いと思います。
さらに、見積書作成フォームを作成します。
これでフォームは完成です。
シートにボタンを設置してフォームを起動してみよう
ボタンを配置する前に、標準モジュールに以下のようにコードを書きましょう。
|
1 2 3 |
Sub frmMainmenu_kidou() frmMainmenu.Show End Sub |
フォーム名＋showメソッドでフォームを起動できましたね。
コードが書けたら、シートにボタンを配置します。
「入力フォーム」シートを用意して、開発タブから挿入を選択し、ボタンを配置します。ボタン名はメインメニュー起動としました。
配置したボタンをクリックしてメインメニューが起動できたら成功です。
２つのフォームを組み合わせよう
上記で作った２つのフォームを連結させてみましょう。
cmbMsakuseiのクリックイベントプロシージャを生成します。
そのプロシージャに以下のようにコードを記述しましょう。
|
1 2 3 |
Private Sub cmbMsakusei_Click() frmMitumori.Show End Sub |
これで２つのフォームを連結でき見積書作成フォームを起動させることができました。
一括作成機能を作り込む
フォーム作成はこのくらいにして、次は一括作成機能を作り込んでいきます。
一括作成機能は前回までに作成した見積書作成の仕組みのことです。
一括作成ボタンから見積作成を可能にする
前回までに書いたコードを一括作成ボタンのクリックイベントプロシージャ（Private Sub cmbMikkatu_Click()）に転記してしまいましょう。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 |
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です。
コードをカスタマイズする
このままでも見積書は作れるのですが、何点かカスタマイズしておきましょう。
作り込むとキリがないのですが、大事な部分を中心に以下のようにカスタマイズしていきます。
- 見積書を作成する場合に確認画面を出す
- 作った見積書シートに名前を付ける
- 同じ名前のシートがあったら処理を中止する
- 作成済みの見積書のログをとる
- シート削除機能の実装
先にカスタマイズ済みのコードを紹介しますので、先ほどのコードに上書きしてしまいましょう。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 |
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 |
見積書を作成する場合に確認画面を出す
まず、一括作成する際に本当に作成して良いか確認のメッセージが出るようにしましょう。
コードの対象は６～１４行目になります。その部分だけ抜粋します。
|
1 2 3 4 5 6 7 8 9 |
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です。
|
1 |
ActiveSheet.Name = Sheets("見積データ一覧").Range("A" & gyoA).Value & "_" & Sheets("見積データ一覧").Range("C" & gyoA).Value |
見積ナンバーと会社名を「＿」でつないだ文字列をシート名としています。
コードを実行して以下のようにシート名が変更されていれば成功です。
同じ名前のシートがあったら処理を中止する
シート名を変更できるようになると不具合も生じます。
それは、同じ名前のシートは作れない、ということです。
試しに、一括作成ボタンを連続でクリックしてみましょう。
すると以下のようにエクセルに怒られます。
エクセルでは同一ファイルに同一名のシートは作れないのでエラーになってしまいます。
これを解消していきましょう。
２０～２８行目が問題解決のコードです。
|
1 2 3 4 5 6 7 8 9 |
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７セルに作成日時を記載しておきます。
コードは３２から３５行目になります。
|
1 2 3 4 |
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列に記載しています。
こうすることによって、いつ何を作ったか自動で履歴が残るようになり、管理面で役立ちます。
当然、作成者情報などを履歴で残すことも可能なので、興味がある方は試しにチャレンジしてみましょう。
成功すると以下のように表示されます。
シート削除機能を実装する
ここで見積書を削除する機能も作っておきましょう。
いろいろ方法はあるかと思いますが、今回は以下のようにコードを書いてみました。
修正・削除ボタンに機能を実装します。
|
1 2 3 4 5 6 7 8 |
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をすることで、ファイルの最後尾から削除することが肝です。通常の昇順で処理してしまうとエラーになってしまいますので気を付けましょう。
９枚目というのは、たまたま僕が使っているファイルの見積書を除いたシート数が８枚だったため、９枚目まで削除すると見積書がすべて消えるということになるので、そのように設定しました。
詳しい削除機能の実装はゆくゆくご紹介していく予定なので、今回は、簡易的なものにとどめておきます。
まとめ
いかがでしたか。
期間指定の方法をご紹介する予定でしたが、ちょっと話がズレて機能のカスタマイズを中心にご紹介することになってしまいました。
しかし、カスタマイズも重要な論点で次回以降にも役立つので今回はご了承ください。
基本的にユーザは機能が関数でできていようがVBAでできていようが意識しません。
どの手法を使っても今回のようにユーザが使いやすいよう配慮することを心がけてください。
次回こそ期間指定する方法をご紹介しますのでお楽しみに。
それでは、また次回お会いしましょう。
販売管理システム作成記事一覧～見積編～
エクセルを駆使して販売管理システムを作ってみる【元データの取り扱い方】
【販売管理システム作成】見積書を期間指定して作成する方法①【コードのカスタマイズ】
【販売管理システム作成】見積書を期間指定して作成する方法②【リストボックス作成】
【販売管理システム作成】見積書を期間指定して作成する方法③【リストボックス作成その２】
【販売管理システム作成】見積データ登録用のフォームを作ろう①【フォームの設定】
【販売管理システム作成】見積データ登録用のフォームを作ろう②【コンボボックスの活用】
【販売管理システム作成】見積データ登録用のフォームを作ろう③【リストボックスの活用】
【販売管理システム作成】見積データ登録用のフォームを作ろう④【エクセルシートに登録】
【販売管理システム作成】見積データ登録用のフォームを作ろう⑤【修正削除機能の実装】
【販売管理システム作成】登録済みのデータを修正削除する方法【見積システム完成編】
