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

2019年9月6日
2019年9月22日
販売管理システム【見積編】

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

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

エクセルを駆使して販売管理システムを作成しています。

前回までで見積データをリストボックスに表示するところまで成功しました。

前回の記事

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

みなさん、こんにちはケンケンです。販売管理システムを自前で作るシリーズをお伝えしています。前回は、見積データ新規登録用フォームをコンボボックスを中心にご紹介しました。 [sitecard subti[…]

今回は、リストボックスに表示されたデータをエクセルシートに転記する方法をご紹介します。

エクセルシートを仮想データベースとして活用していきます。

1 前回の復習と一部追加
- 1.1 cmbTuika_Clickプロシージャに機能を追加しよう
2 登録ボタンをクリックしたときの処理
3 リストボックスをクリックしたときの処理
- 3.1 修正・削除ボタンをクリック可能にする
4 フォームと新規登録ボタンを連動させておこう
- 4.1 おまけ：閉じるボタンをクリックしたときの処理
5 まとめ

前回の復習と一部追加

前回はデータ追加ボタンをクリックした時に、リストボックスにデータを転記して合計金額を

集計し表示するところまで学習しました。

フォームの状況とコードを以下に示しておきますので参考にしてください。

フォームを作り込むことは作業工程が多く大変ですが、一度完成させるとユーザーにとって使い勝手の

良いものを提供できるのでしっかり作って行きましょう。

数量テキストボックスに０から９以外の値が代入されたら空白にするコード

Private Sub txtSuryou_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If Chr(KeyAscii) &lt; "0" Or Chr(KeyAscii) &gt; "9" Then
        KeyAscii = 0
    End If
End Sub

Private Sub txtSuryou_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

If Chr(KeyAscii) < "0" Or Chr(KeyAscii) > "9" Then

KeyAscii = 0

End If

End Sub

データ追加ボタンをクリックした時に起きるアクションを書いたコード

Private Sub cmbTuika_Click()
    With lstMeisai
        .AddItem txtMitumoriNo.Text
        .List(.ListCount - 1, 1) = txtMhiduke.Text
        .List(.ListCount - 1, 2) = txtTokuisaki.Text
        .List(.ListCount - 1, 3) = txtSyouhin.Text
        .List(.ListCount - 1, 4) = txtSuryou.Text
        .List(.ListCount - 1, 5) = tanni
        .List(.ListCount - 1, 6) = txtTanka.Text
        .List(.ListCount - 1, 7) = txtKingaku.Text
        .List(.ListCount - 1, 8) = txtTax.Text
        .List(.ListCount - 1, 9) = txtZeikomi.Text
    End With
    txtSyouhin.Text = ""
    txtSuryou.Text = ""
    txtTanka.Text = ""
    txtKingaku.Text = ""
    txtTax.Text = ""
    txtZeikomi.Text = ""
    txtGoukei.BackColor = &amp;H80000005
    txtSyouhin.BackColor = &amp;H8000000F
    txtTanka.BackColor = &amp;H8000000F
    txtKingaku.BackColor = &amp;H8000000F
    txtTax.BackColor = &amp;H8000000F
    txtZeikomi.BackColor = &amp;H8000000F
    cboSyouhin.SetFocus
    cmbTuika.Enabled = False
    txtMitumoriNo.Enabled = False
    txtMhiduke.Enabled = False
    cboTokuisaki.Enabled = False
    
    
    Dim Lrow
    Dim goukei
    Dim cnt
    Lrow = lstMeisai.ListCount - 1
    goukei = 0
    For cnt = 0 To Lrow
        goukei = goukei + lstMeisai.List(cnt, 9)
    Next
    txtGoukei.Text = Format(goukei, "#,###")
End Sub

Private Sub cmbTuika_Click()

With lstMeisai

.AddItem txtMitumoriNo.Text

.List(.ListCount - 1, 1) = txtMhiduke.Text

.List(.ListCount - 1, 2) = txtTokuisaki.Text

.List(.ListCount - 1, 3) = txtSyouhin.Text

.List(.ListCount - 1, 4) = txtSuryou.Text

.List(.ListCount - 1, 5) = tanni

.List(.ListCount - 1, 6) = txtTanka.Text

.List(.ListCount - 1, 7) = txtKingaku.Text

.List(.ListCount - 1, 8) = txtTax.Text

.List(.ListCount - 1, 9) = txtZeikomi.Text

End With

txtSyouhin.Text = ""

txtSuryou.Text = ""

txtTanka.Text = ""

txtKingaku.Text = ""

txtTax.Text = ""

txtZeikomi.Text = ""

txtGoukei.BackColor = &H80000005

txtSyouhin.BackColor = &H8000000F

txtTanka.BackColor = &H8000000F

txtKingaku.BackColor = &H8000000F

txtTax.BackColor = &H8000000F

txtZeikomi.BackColor = &H8000000F

cboSyouhin.SetFocus

cmbTuika.Enabled = False

txtMitumoriNo.Enabled = False

txtMhiduke.Enabled = False

cboTokuisaki.Enabled = False

Dim Lrow

Dim goukei

Dim cnt

Lrow = lstMeisai.ListCount - 1

goukei = 0

For cnt = 0 To Lrow

goukei = goukei + lstMeisai.List(cnt, 9)

txtGoukei.Text = Format(goukei, "#,###")

End Sub

cmbTuika_Clickプロシージャに機能を追加しよう

前回のコードに一部追加をお願いします。

前回は、データ追加ボタンをクリックしたときのアクションをcmbTuika_Clickプロシージャに記述しましたが、コマンドボタンをクリック可能にするコードを書き忘れました。

cboTokuisaki.Enabled = Falseの下あたりに下記コードを追加してください。

    cmbTouroku.Enabled = True

1	cmbTouroku.Enabled = True

これでデータ追加したと同時に登録ボタンをクリック可能にできます。

忘れると永遠に登録作業ができなくなってしまうところでした。

登録ボタンをクリックしたときの処理

リストボックスに表示されているデータをエクセルシートに転記します。

重要なところですが、今までの知識で対応可能なのでしっかり作って行きましょう。

ボタンクリック時の処理をまとめよう

リストボックスにデータがないときはプロシージャを離脱する
登録確認を促すメッセージボックスを表示する
エクセルシートに転記する
転記完了後にリストボックスの値をクリアする
次の見積情報入力を可能にするため見積Noを更新する

今回は、上記項目の処理を進めます。

リストボックスにデータがないときはプロシージャを離脱する

登録ボタンをクリックしたときにリストボックスにデータがない状態で処理を進めるのはよろしくないですね。

そこで、データの有無を確認し、無かったらプロシージャを離脱するコードを書きます。

まずは、新しいプロシージャを生成します。

VBEを起動し、登録ボタンをダブルクリックして以下のようにClickイベントプロシージャを生成しましょう。

そのプロシージャにコードを書いていきます。

Private Sub cmbTouroku_Click()
    If lstMeisai.ListCount = 0 Then
        MsgBox "明細入力してください。", vbInformation
        Exit Sub
    End If
End Sub

Private Sub cmbTouroku_Click()

If lstMeisai.ListCount = 0 Then

MsgBox "明細入力してください。", vbInformation

Exit Sub

End If

End Sub

条件分岐を使ってリストボックスにデータがない場合にExitSubでプロシージャを離脱します。

リストボックス内にデータがあるか確認するには、ListCountプロパティを使います。

データが１行あれば１を返します。もし、データがなければ０を返します。

その性質を生かしてデータがない場合つまり０が返ってきたときに、メッセージボックスに注意喚起のメッセージを表示させてプロシージャを離脱しています。

このコードを書いておけば万が一リストボックスが空のときにシートに転記してしまうことがなくなります。

登録確認を促すメッセージボックスを表示する

データの有無を確認した後は、本当に登録して良いか確認する必要があります。

登録ボタンをユーザーが間違えてクリックしてしまった時の防護策になります。

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

Dim res

res = MsgBox("登録します。よろしいですか？", vbYesNo + vbInformation, "確認")

If res = vbNo Then

Exit Sub

End If

cmbTouroku_Clickプロシージャに追記してください。

登録して良いかどうかユーザーに問い合わせて、回答を変数resに格納します。

もし、回答がいいえ（vbNo）であったらプロシージャから離脱します。

メッセージボックスについては以下の記事で詳しく解説していますので参考にしてください。

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

みなさん、こんにちはケンケンです。今回もユーザーフォームの活用方法をご紹介します。今までの記事をご覧いただいていない方は以下をお読みいただくことをおススメします。【ExcelVBA】ユーザーフォー[…]

エクセルシートに転記する

今回のメインイベントとなるエクセルシートへ転記を解説していきます。

肝はリストボックスの行と列は０から始まるということと、繰り返し処理をうまく使うことです。

    Dim Lrow
    Lrow = Sheets("見積データ一覧").Range("A" &amp; Rows.Count).End(xlUp).Row + 1
    Dim cnt
    For cnt = 0 To lstMeisai.ListCount - 1
        Sheets("見積データ一覧").Range("A" &amp; Lrow).Value = lstMeisai.List(cnt, 0)
        Sheets("見積データ一覧").Range("B" &amp; Lrow).Value = lstMeisai.List(cnt, 1)
        Sheets("見積データ一覧").Range("C" &amp; Lrow).Value = lstMeisai.List(cnt, 2)
        Sheets("見積データ一覧").Range("D" &amp; Lrow).Value = lstMeisai.List(cnt, 3)
        Sheets("見積データ一覧").Range("F" &amp; Lrow).Value = lstMeisai.List(cnt, 4)
        Sheets("見積データ一覧").Range("G" &amp; Lrow).Value = lstMeisai.List(cnt, 5)
        Sheets("見積データ一覧").Range("H" &amp; Lrow).Value = lstMeisai.List(cnt, 6)
        Sheets("見積データ一覧").Range("I" &amp; Lrow).Value = lstMeisai.List(cnt, 7)
        Sheets("見積データ一覧").Range("J" &amp; Lrow).Value = lstMeisai.List(cnt, 8)
        Lrow = Lrow + 1
    Next

Dim Lrow

Lrow = Sheets("見積データ一覧").Range("A" & Rows.Count).End(xlUp).Row + 1

Dim cnt

For cnt = 0 To lstMeisai.ListCount - 1

Sheets("見積データ一覧").Range("A" & Lrow).Value = lstMeisai.List(cnt, 0)

Sheets("見積データ一覧").Range("B" & Lrow).Value = lstMeisai.List(cnt, 1)

Sheets("見積データ一覧").Range("C" & Lrow).Value = lstMeisai.List(cnt, 2)

Sheets("見積データ一覧").Range("D" & Lrow).Value = lstMeisai.List(cnt, 3)

Sheets("見積データ一覧").Range("F" & Lrow).Value = lstMeisai.List(cnt, 4)

Sheets("見積データ一覧").Range("G" & Lrow).Value = lstMeisai.List(cnt, 5)

Sheets("見積データ一覧").Range("H" & Lrow).Value = lstMeisai.List(cnt, 6)

Sheets("見積データ一覧").Range("I" & Lrow).Value = lstMeisai.List(cnt, 7)

Sheets("見積データ一覧").Range("J" & Lrow).Value = lstMeisai.List(cnt, 8)

Lrow = Lrow + 1

まず、見積データ一覧シートのA列最終行＋１行目を変数Lrowに格納します。

カウント変数cntを用意し、リストボックスの最初の行（０）から最後の行（lstMeisai.ListCount – 1）まで繰り返し処理をします。

リストボックスの行と列は０から始まりますから繰り返しの初期値は０で良いですね。

また最後の行はListCountプロパティで取得したリストボックスに存在する行数から１マイナスした行数になります。

さらにコードの次行からシートに書き出しています。イメージは下図のような感じです。

Lrow = Lrow + 1で最終行に１追加した値を変数Lrowに代入し直します。

さらにリストボックスの最終行（lstMeisai.ListCount – 1）まで繰り返します。

コードが書けたら、フォームを起動させ実際にシートに転記できるか確認してみましょう。

転記完了後に必要な処理

とうとうエクセルシートに転記することができました。

ここからは転記したあとのフォームに仕掛けをうってユーザーが次の入力をしやすいように工夫します。

リストボックスをきれいにしよう

転記後にリストボックスに値が残ってしまうと次に登録したい時にやっかいですね。

そこでリストボックスの値を消去してきれいにしましょう。

lstMeisai.Clear

1	lstMeisai.Clear

シート転記コードの後に上記コードを追加してください。

登録後にリストボックスの中身が消えていれば成功です。

次の見積情報入力を可能にするため見積Noの更新など

登録が終わったらすぐ次の登録へ進むため見積Noが更新されていると使い勝手が良いですね。

Initializeで使ったコードをそのままコピーして使います。

    Lrow = Sheets("見積データ一覧").Range("A" &amp; Rows.Count).End(xlUp).Row
    txtMitumoriNo.Text = Format(Sheets("見積データ一覧").Range("A" &amp; Lrow).Value + 1, "00000")

1 2	Lrow = Sheets("見積データ一覧").Range("A" & Rows.Count).End(xlUp).Row txtMitumoriNo.Text = Format(Sheets("見積データ一覧").Range("A" & Lrow).Value + 1, "00000")

変数Lrowはリストボックスから転記する際に宣言したものを使い回しました。

このコードを追記することで登録終了後に見積Noが更新されるはずです。

さらに、追加で得意先テキストボックスと合計金額テキストボックスの値も消去します。

    txtTokuisaki = ""
    txtGoukei = ""

1 2	txtTokuisaki = "" txtGoukei = ""

最後に登録後は得意先コンボボックスにフォーカスが移動するようにしましょう。

    cboTokuisaki.Enabled = True
    cboTokuisaki.SetFocus

1 2	cboTokuisaki.Enabled = True cboTokuisaki.SetFocus

データ追加ボタン処理を設定する際に得意先コンボボックスは編集不可にしていたので、

それを解除してからフォーカスを移動しています。

リストボックスをクリックしたときの処理

次回以降でデータの修正や削除機能を作成していく予定なので、その前段階としてひとつ仕掛けを作っておきます。

修正・削除ボタンをクリック可能にする

修正・削除ボタンはリストボックスをクリックしたときにはじめて機能することが望ましいでしょう。

そこで、リストボックスのChangeイベントプロシージャを作成し、以下のようにコードを書いてください。

Private Sub lstMeisai_Change()
    cmbSyusei.Enabled = True
    cmbSakujo.Enabled = True
End Sub

Private Sub lstMeisai_Change()

cmbSyusei.Enabled = True

cmbSakujo.Enabled = True

End Sub

これで、リストボックスをクリックした時にボタンが編集可能の状態になります。

フォームと新規登録ボタンを連動させておこう

新規登録ボタンをクリックしたときに見積情報登録フォームが起動するようにしておきましょう。

以下のように新規登録ボタンをダブルクリックして、Clickイベントプロシージャを生成しコードを記述します。

Private Sub cmbMsinki_Click()
    frmMitumoriCreat.Show
End Sub

Private Sub cmbMsinki_Click()

frmMitumoriCreat.Show

End Sub

これで、２つのフォームを連動できました。

おまけ：閉じるボタンをクリックしたときの処理

最後に、見積情報登録フォームの閉じるボタンにコードを付しておきます。

Private Sub cmbMclose_Click()
    Unload Me
End Sub

Private Sub cmbMclose_Click()

Unload Me

End Sub

これで、フォームを閉じることができるようになりました。

まとめ

いかがでしたか。

今回は、フォームからエクセルシートに転記する方法をメインにお届けしました。

複雑に思うかもしれませんが、使っているテクニックは基本的なものばかりなので、分からなくなったら復習してじっくり進んでください。

次回は、修正や削除機能を作っていく予定ですのでお楽しみに。

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

今回書いたコード

見積情報登録フォーム（frmMitumoriCreat）

Private Sub cmbTouroku_Click()
    If lstMeisai.ListCount = 0 Then
        MsgBox "明細入力してください。", vbInformation
        Exit Sub
    End If
    
    Dim res
    res = MsgBox("登録します。よろしいですか？", vbYesNo + vbInformation, "確認")
    If res = vbNo Then
        Exit Sub
    End If
    
    Dim Lrow
    Lrow = Sheets("見積データ一覧").Range("A" &amp; Rows.Count).End(xlUp).Row + 1
    Dim cnt
    For cnt = 0 To lstMeisai.ListCount - 1
        Sheets("見積データ一覧").Range("A" &amp; Lrow).Value = lstMeisai.List(cnt, 0)
        Sheets("見積データ一覧").Range("B" &amp; Lrow).Value = lstMeisai.List(cnt, 1)
        Sheets("見積データ一覧").Range("C" &amp; Lrow).Value = lstMeisai.List(cnt, 2)
        Sheets("見積データ一覧").Range("D" &amp; Lrow).Value = lstMeisai.List(cnt, 3)
        Sheets("見積データ一覧").Range("F" &amp; Lrow).Value = lstMeisai.List(cnt, 4)
        Sheets("見積データ一覧").Range("G" &amp; Lrow).Value = lstMeisai.List(cnt, 5)
        Sheets("見積データ一覧").Range("H" &amp; Lrow).Value = lstMeisai.List(cnt, 6)
        Sheets("見積データ一覧").Range("I" &amp; Lrow).Value = lstMeisai.List(cnt, 7)
        Sheets("見積データ一覧").Range("J" &amp; Lrow).Value = lstMeisai.List(cnt, 8)
        Lrow = Lrow + 1
    Next
    lstMeisai.Clear
    Lrow = Sheets("見積データ一覧").Range("A" &amp; Rows.Count).End(xlUp).Row
    txtMitumoriNo.Text = Format(Sheets("見積データ一覧").Range("A" &amp; Lrow).Value + 1, "00000")
    txtTokuisaki = ""
    txtGoukei = ""
    cboTokuisaki.Enabled = True
    cboTokuisaki.SetFocus
End Sub

Private Sub lstMeisai_Change()
    cmbSyusei.Enabled = True
    cmbSakujo.Enabled = True
End Sub

Private Sub cmbMclose_Click()
    Unload Me
End Sub