引数値渡しでまとめたプログラムを使って入出庫者名の登録と削除をする　【VBA在庫管理#21】

同期のサクラ(ドラマ)観て全米が泣いてるよね?　どうもoReです(泣)。

今回は、ComboTSプロシージャを改良していきます。

変動する部分を引数にする

前回作成したComboTSプロシージャは、
TourokuフォームのComboBox1用のプロシージャとなっています。

これでは、まとめた意味がなく使えない子認定です(泣)。

『私には夢があります。
ComboTSを使える有能な子に育てる事です。』

要は変動する部分を引数に渡してもらえばいいわけです。

引数の作成

・どこのコンボボックスの登録・削除するの?

ByVal Box As Object

・どこのシートに登録・削除するの?

ByVal Ws As Worksheet
※ObjectでもOK

・どの列に登録・削除するの?

ByVal Retu As Long

・何を登録・削除するの?

ByVal ListName As String

'コンボボックス用　シートに登録・削除処理
Public Sub ComboTS(ByVal Box As Object, ByVal Ws As Worksheet, _
　　　　　　　　　　ByVal Retu As Long, ByVal ListName As String, ByVal TS As String)

置換

・置換したい部分を選択→Ctrl + H→置換後の文字列(W):に入力

※対象の部分に注意してね(モジュールかプロシージャでね)
置換?対象?の方はこちら→【VBA在庫管理#14】

　　↓こんな感じ

'コンボボックス用　シートに登録・削除処理
　　'Box=ComboBox, Ws=シート, Retu=列番号, ListName=登録削除名, TS=登録(T)or 削除(S)
Public Sub ComboTS(ByVal Box As Object, ByVal Ws As Worksheet, _
　　　　　　　　　　ByVal Retu As Long, ByVal ListName As String, ByVal TS As String)
　　Dim Knskcell As Range
　　Dim YN As VbMsgBoxResult
　　Dim LastRow As Long

　　If Box = “” Then
　　　　Exit Sub
　　Else
　　　　Set Knskcell = Ws.Columns(Retu).Find(what:= Box, lookat:= xlWhole)
　　　　If TS = “T” Then　‘引数TSがTだった場合
　　　　　　If Knskcell Is Nothing Then
　　　　　　　　YN = MsgBox(ListName & " :　” & Box & vbCrLf & vbCrLf & _
 　　　　　　　　　　　　　　”この" & ListName & "名を登録しますか?”, vbYesNo + vbQuestion, “登録確認”)
　　　　　　　　If YN = vbYes Then
　　　　　　　　　　LastRow = Ws.Cells(Rows.Count, Retu).End(xlUp).Row
　　　　　　　　　　Ws.Cells(LastRow + 1, Retu) = Box
　　　　　　　　　　MsgBox Box & “を登録しました。”
　　　　　　　　End If
　　　　　　End If
　　　　ElseIf TS = “S” Then　‘引数TSがSだった場合
　　　　　　If Not Knskcell Is Nothing Then
　　　　　　　　YN = MsgBox(ListName & ":　” & Box & vbCrLf & vbCrLf & _ 
　　　　　　　　　　　　　　”この" & ListName &"名の登録を削除しますか?”, vbYesNo + vbQuestion, “登録削除確認”)
　　　　　　　　If YN = vbYes Then
　　　　　　　　　　Knskcell.Delete(xlShiftUp)　'セルを削除した際に上にシフトする
　　　　　　　　　　MsgBox Box & “を削除しました。”
　　　　　　　　　　Box = “”
　　　　　　　　End If
　　　　　　End If
　　　　End If
　　End If
End Sub

ComboTsの引数に値を渡す

Tourokuフォームモジュールの、ComboBox1_KeyDownプロシージャ変更

'設定シートにメーカー名登録処理
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
　　If KeyCode = 13 Then
　　　　Call ComboTS(ComboBox1, Sheet3, 1, "メーカー", "T")　'ComboTSに引数を渡すよ
　　　　Call UserForm_Initialize
　　End If
End Sub

Tourokuフォームモジュールの、ComboBox1_DblClickプロシージャ変更

'設定シートのメーカー名削除処理
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
　　Call ComboTS(ComboBox1, Sheet3, 1, "メーカー","S")　'ComboTSに引数を渡すよ
　　Call UserForm_Initialize
End Sub

動作確認してみてください。

ちゃんと登録・削除できてますか?

※ComboBoxの前に、Tourokuつけなくていいの?

いいんです!!(川平風)

Tourokuフォームモジュール上から引数へ渡しているので省略してもOK

ComboBoxへ登録するプログラムも標準モジュールへ書き引数を渡す

TourokuフォームのUserForm_Initializeに書いてある、
ComboBoxへ登録するプログラムを標準モジュール(Module1)に書きましょう。

　　↓こんな感じ

'コンボボックスセット処理
　　'Box=ComboBox, Ws=シート, Retu=列番号
Public Sub ComboSet(ByVal Box As Object, ByVal Ws As Worksheet, ByVal Retu As Long)
　　Dim LastRow As Long
　　Box.Clear
　　With Ws
　　　　LastRow = .Cells(Rows.Count, Retu).End(xlUp).Row
　　　　If LastRow = 1 Then　'設定シートに1つも登録されていない場合
　　　　　　Exit Sub　'リストに設定シートの項目を表示させない
　　　　ElseIf LastRow = 2 Then　'設定シートに1つしか登録されていない場合
　　　　　　Box.AddItem .Cells(2, Retu)　'ComboBox.Listに1つのデータを登録できない為AddItemを使う
　　　　Else
　　　　　　Box.List = .Range(.Cells(2, Retu), .Cells(LastRow, Retu)).Value
　　　　End If
　　End With
End Sub

TourokuフォームのUserForm_Initializeのプロシージャを変更

'Tourokuフォーム初期化
Private Sub UserForm_Initialize()
　　Call ComboSet(ComboBox1, Sheet3, 1)　'ComboSetに引数を渡すよ
End Sub

ComboTSプロシージャでComboSetを呼び出す

Module1のComboTSプロシージャの設定シートに登録・削除後にComboSetを呼び出します。

　　↓登録処理後はここに追加

　　Ws.Cells(LastRow + 1, Retu) = Box
　　MsgBox Box & “を登録しました。”
　　ComboSet(Box, Ws, Retu)
End If

　　↓削除処理後はここに追加

　　MsgBox Box & “を削除しました。”
　　Box = “”
　　ComboSet(Box, Ws, Retu)
End If

こうすることで、メーカー名登録処理・メーカー名削除処理の
Call UserForm_Initializeを消すことができます。

'設定シートにメーカー名登録処理
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
　　If KeyCode = 13 Then
　　　　Call ComboTS(ComboBox1, Sheet3, 1, "メーカー", "T")　'ComboTSに引数を渡すよ
　　　　Call UserForm_Initialize　←消す
　　End If
End Sub

※メーカー名削除処理のCall UserForm_Initializeも消してください。

動作確認してみてください。

ちゃんとコンボボックスに登録できてますか?

でっ!?　全米は泣いてないんだが?

まあ、まて…

起
承
転←今ここよ!!
結

Mainフォームの入出庫者名入力をTextBox1からComboBox1へ変更

おまたせしました、全米が泣きますよ!!　多分…

Mainフォームのテキストボックスをコンボボックスに変更します。

TextBox1を選択→Delete→ComboBox1を挿入

忘れないように、TexBox1をComboBox1へ置換しましょう。
※対象はモジュールだよ

そうしたら、設定シートのセルB1に『入出庫者名登録』と入力し、
設定シートのB列(2列目)に入出庫者名を登録・削除していくようにします。

MainフォームにComboBox1_DblClickと、ComboBox_KeyDownを作成

KeyDown?の方はこちら→【VBA在庫管理#12】

DblClick?の方はこちら→【VBA在庫管理#18】

Mainフォームモジュールの、ComboBox1_KeyDownプロシージャ

'設定シートに入出庫者名登録処理
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
　　If KeyCode = 13 Then
　　　　Call ComboTS(ComboBox1, Sheet3, 2, "入出庫者", "T")　'ComboTSに引数を渡すよ
　　End If
End Sub

Mainフォームモジュールの、ComboBox1_DblClickプロシージャ

'設定シートの入出庫者名削除処理
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
　　Call ComboTS(ComboBox1, Sheet3, 2, "入出庫者", "S")　'ComboTSに引数を渡すよ
End Sub

Mainフォームモジュールの、UserForm_Initializeプロシージャに追加

'Mainフォーム初期化
Private Sub UserForm_Initialize()
　　Dim LastRow As Long

　　LastRow = Sheet2.Cells(Rows.Count, 9).End(xlUp).Row
　　If LastRow > 2 Then
　　　　ListBox1.ColumnCount = 8
　　　　ListBox1.ColumnWidths = "110;50;40;110;110;120;30;30"
　　　　ListBox1.List = Sheet2.Range("B3:I" & LastRow).Value
　　End If
　　Call ComboSet(ComboBox1, Sheet3, 2)　'ComboSetに引数を渡すよ
　　　　以下省略
End Sub

動作確認してみてください。

ちゃんと、入出庫者名を登録・削除できてますか?

どう?全米とまではいかなくても、泣けるでしょ!?

いやいや、コンボボックスを2個しか使ってないから効果がわかりづらいだけよ。
100個コンボボックスを使ってごらんよ!!　泣けるから…

まとめ

全然泣けねーよって?
OKわかった。次だ次こそは…

次回　プロのグラマーな方達のタブーに迫る(笑)

インポートとエクスポートを使って部品編集フォームを作る　【VBA在庫管理#22】

進撃の俺!!　どうもoReです。 今回は、ファイルのインポートとエクスポートを使っていきます。 モジュールの解放 モジュールの解放は、作成したユーザーフォームや、 標準モジュール等を削除したい時に使用します。 ・削除したいモジ...

oregramming.com

2019.12.10

ExcelVBA部品在庫管理【目次】へ戻る