[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『Excel在庫管理で入荷処理★その２』（らんきち）
の続きです。
＞対象にするデータブックのなかから、処理すべきデータブックを選ぶという方式
はい、それでお願いします。 ちなみにファイルを入れるフォルダも毎日「11.25」というような名前で作成され、そこに在庫ファイルともう一つのファイルが入ります。 保存のタイミングは、出荷で在庫を引き当てた時、入荷で処理の「更新」を行った時と考えています。
＞画面が呼び出せないというのは？ユーザーフォームが表示されない？あるいはデータブックが表示されない？
呼び出しのコマンドボタンを押した時点で 「実行時エラー'91'オブジェクト変数またはWithブロック変数が定義されていません」 というエラーが出てフォームもデータブック自体も表示されません。 なので転記もできないという状態です。
SyukkaForm、TourokuFormともに下記のルーティンを追加しました
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
ThisWorkbook.Activate
End Sub
☆SyukkaFormのコード
Option Explicit
Private Sub UserForm_Initialize()
SyukkaForm.putSyukkaDate.Value = Date
'商品名のドロップダウンリスト設定
Dim g0 As Long
Dim lRow As String
With Worksheets("商品マスタ")
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
For g0 = 1 To 8
With Controls("putSyohin" & g0)
.ColumnWidths = "50"
.RowSource = "商品マスタ!C2:C" & lRow
End With
Next
End Sub
Private Sub Nyuryoku_Click()
'出荷日に日付型をセット
Dim Hiduke As Date
If IsDate(putSyukkaDate.Text) = True Then
Hiduke = Format(putSyukkaDate.Text, "yyyy/mm/dd")
putSyukkaDate.Text = Hiduke
Else
MsgBox "日付はyyyy/m/dで入力してください", vbInformation
Exit Sub
End If
'出荷依頼シートへの転記
Dim g0 As Long
Dim lRow As String
Dim code1 As String, code2 As String
Dim Ctrl As Control
With Worksheets("出荷依頼")
lRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
code1 = .Cells(lRow, "A").Value
code2 = putTensoNo.Text
If code1 = code2 Then
MsgBox "出荷コードが入力されていません"
Exit Sub
End If
For g0 = 1 To 5
If Controls("putSyohin" & g0) = "" Then Exit For
.Cells(lRow, "a").Value = putTensoNo.Text
.Cells(lRow, "b").Value = Controls("putSyohin" & g0).Value
.Cells(lRow, "c").Value = Controls("putSyukkasu" & g0).Value
.Cells(lRow, "d").Value = putSyukkaDate.Text
lRow = lRow + 1
Next g0
End With
For Each Ctrl In Me.Controls
If Ctrl.Name Like "put*" Then
Ctrl.Value = ""
SyukkaForm.putSyukkaDate.Value = Date
End If
Next
End Sub
Private Sub AllClr_Click()
'入力フォームのクリア
Dim myCtrl As Control
For Each myCtrl In Controls
If TypeName(myCtrl) = "TextBox" Then _
myCtrl.Value = vbNullString
Next
For Each myCtrl In Controls
If TypeName(myCtrl) = "ComboBox" Then _
myCtrl.Value = vbNullString
Next
End Sub
Private Sub NyuryokuCls_Click()
'フォームを閉じる
Unload Me
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
ThisWorkbook.Activate
End Sub
☆TourokuFormのコード
Option Explicit
Private Sub HinTouroku_Click()
'商品登録
Dim lRow As Long
Dim c1 As String, c2 As String
Dim Ctrl As Control
With Worksheets("商品マスタ")
lRow = .Range("A" & Rows.Count).End(xlUp).Row
c1 = .Cells(lRow, "A").Value
c2 = txtSyohinId.Text
If c1 = c2 Then
MsgBox "商品IDが重複しています"
Exit Sub
End If
lRow = lRow + 1
.Cells(lRow, "a").Value = txtSyohinId.Text
.Cells(lRow, "b").Value = txtSyohinmei.Text
.Cells(lRow, "c").Value = txtHinRyaku.Text
End With
For Each Ctrl In Me.Controls
If Ctrl.Name Like "txt*" Then
Ctrl.Value = ""
End If
Next
End Sub
Private Sub TourokuClr_Click()
'入力フォームのクリア
Dim myCtrl As Control
For Each myCtrl In Controls
If TypeName(myCtrl) = "TextBox" Then _
myCtrl.Value = vbNullString
Next
End Sub Private Sub TourokuCls_Click()
'フォームを閉じる
Unload Me
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
ThisWorkbook.Activate
End Sub
今こうなっています。
入荷処理の件は了解いたしました。ありがとうございました。
ユーザーフォームが呼び出されない件、分かりました。
マクロブックを開いた際に「マクロを有効にする」でデータブックが呼び出されますが、その後データブックの方だけを 一旦閉じてしまったのでエラーになったようです。 一度閉じて再度起動した場合はどのユーザーフォームを呼び出すにもエラーになるんですね。 ここが分かっていませんでした。
最初からデータブックを開いた状態であれば転記までうまくいきました。
すみませんでした。
（らんきち）
何度もすみません。
今日また現場からダメ出しが入りました。
上司が「入荷日は残せ。ロットNOと賞味期限が同じ行が複数あってもいい」と言ったのでそのようにしていたのですが 指示を出した現場から「同じロットNoと同じ賞味期限のものが複数行に渡って指示書に書いてあると作業しにくい」と言われ、 上司から「入荷履歴シートを別ファイルでもいいから作り、少なくとも出荷指示書は“同じロットNo・同じ賞味期限”のものは合算して出力するように」 と言われました…
当面、入荷履歴を別ファイルか別シートに残し（ここでは複数商品を一つのシートにまとめてOK）、在庫シートの 表示を同じロットNo・同じ賞味期限”のものを一つの行にまとめるように手入力で修正することになりました。
これ以上あれこれ言ってると本当にぶらっと様に見放されそうなので、入荷用シートに入力するフォームを作り、 入荷シートを元に在庫シートに反映させるようなコードを考えようと思います。 最初に書いていただいたユーザーフォーム2のコードを書き換えることで何とか対応を考えようかと…
とりあえずファイル分割の件だけでも（また「これだけでも」とか言ってすみません）引き続きお教えください…
（らんきち）
メニューにボタンを追加して、"ブックを開く" をマクロ登録。 なお、処理中にバグなどでエラーになり、そのまま継続すると、例の「オートメーションエラー」になる。 かならず、いったんエクセルを終わらせ、再度、マクロブックを開き直して処理してね。
出荷指示書の変更他については、ちょっと考えてみる。
●Module1 に 以下を追加
Sub ブックを開く()
Dim fName As Variant
If Not DataBook Is Nothing Then
MsgBox "開いている" & DataBook.Name & "を閉じてから処理してください"
Exit Sub
End If
fName = Application.GetOpenFilename("在庫ブック,*.xlsx", , "在庫ブックの選択")
Set DataBook = Workbooks.Open(fName)
ThisWorkbook.Activate
End Sub
●Module1 の各プロシジャの最初（If IsFormLoaded Then Exit Sub の前）
If Not IsOpen Then Exit Sub を追加
●Module2に以下追加
Function IsOpen() As Boolean
If DataBook Is Nothing Then
MsgBox "在庫ブックを開いてから処理してください"
Exit Function
End If
IsOpen = True
End Function
●ThisWorkbook を以下に入れ替え
Option Explicit
Dim WithEvents xlApp As Application
Private Sub Workbook_Open() Set xlApp = Application End Sub
Private Sub xlApp_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
If Wb Is DataBook Then Set DataBook = Nothing
End Sub
●各フォームモジュールのUserForm_QueryClose の ThisWorkbook.Activate の前に
DataBook.Save 'これを追加
ThisWorkbook.Activate
(ぶらっと)
追伸
現場に渡す出荷指図書の編集だけでいいのなら、商品在庫シートは、今のままで 指示書のみ集約して作成することはできるけど。どうする？ (引当は、この集約されたイメージをベースに集約されていない商品在庫シートを相手に実行するけど、たぶん大丈夫。）
(ぶらっと)
もし、↑の考え方でいいなら。 （ただし、集約は、出荷依頼データの１行単位。同じ商品、賞味期限、ロットでも出荷依頼データがわかれていれば、それぞれの中で集約）
make出荷指示書
１．最初の変数定義に以下を追加
Dim dicW As Object
Dim dKey As Variant
Dim wk As Variant
２．fnPut の最後
With .Range("A" & .Rows.Count).End(xlUp).Offset(1)
.Resize(UBound(v, 1), UBound(v, 2)).Value = v
End With
これを以下に
'セットする配列が複数行の場合、賞味期限、ロットで集約
w = v
If UBound(w, 1) > 1 Then
Set dicW = CreateObject("Scripting.Dictionary")
For i = LBound(v, 1) To UBound(v, 1)
dKey = v(i, 1) & vbTab & v(i, 2) & vbTab & v(i, 3) & vbTab & v(i, 4) & vbTab & v(i, 6) & vbTab & v(i, 7)
dicW(dKey) = dicW(dKey) + v(i, 5)
Next
ReDim w(1 To dicW.Count, 1 To UBound(w, 2))
i = 0
For Each dKey In dicW
i = i + 1
wk = Split(dKey, vbTab)
w(i, 1) = wk(0)
w(i, 2) = wk(1)
w(i, 3) = wk(2)
w(i, 4) = wk(3)
w(i, 5) = dicW(dKey)
w(i, 6) = wk(4)
w(i, 7) = wk(5)
Next
Set dicW = Nothing
End If
With .Range("A" & .Rows.Count).End(xlUp).Offset(1)
.Resize(UBound(w, 1), UBound(w, 2)).Value = w
End With
(ぶらっと)
ありがとうございます！ 集約するのは指示書だけで大丈夫です（その方が助かります！） これでしばらくテストします。
ところでまた一つ教えてください。 自作のユーザーフォームなんですが、どうしても入力したいシートがアクティブにならずにたまたま開いている シートにデータが追加されています。 ネットの記事を参考にいじってみましたがやはりシートが選択されません。 どこが間違っているのでしょうか…
☆登録フォームのコード
Option Explicit Private Sub HinTouroku_Click()
'商品登録
Dim lRow As Long
Dim c1 As String, c2 As String
Dim Ctrl As Control
With ThisWorkbook.Worksheets("商品マスタ")
lRow = .Range("A" & Rows.Count).End(xlUp).Row
c1 = .Cells(lRow, "A").Value
c2 = txtShohinId.Text
If c1 = c2 Then
MsgBox "商品IDが重複しています"
Exit Sub
End If
lRow = lRow + 1
.Cells(lRow, "a").Value = txtShohinId.Text
.Cells(lRow, "b").Value = txtSyohinmei.Text
.Cells(lRow, "c").Value = txtHinRyaku.Text
End With
For Each Ctrl In Me.Controls
If Ctrl.Name Like "txt*" Then
Ctrl.Value = ""
End If
Next
End Sub
Private Sub TourokuClr_Click()
'入力フォームのクリア
Dim myCtrl As Control
For Each myCtrl In Controls
If TypeName(myCtrl) = "TextBox" Then _
myCtrl.Value = vbNullString
Next
End Sub Private Sub TourokuCls_Click()
'フォームを閉じる
Unload Me
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
DataBook.Save
ThisWorkbook.Activate
End Sub
出荷フォームのコードも上に書いたとおりです。
※ With With ThisWorkbook.Worksheets("出荷依頼")のように記述してます
よろしくお願いします
（らんきち）
このコードを動かす時の構成は、データブックとマクロブックは分離されているバージョンだと思うけど
ThisWorkbook.Worksheets("商品マスタ")
これは、マクロブックのシートである"商品マスタ"を相手にしている。
マクロブックに、このシートがあるの？
それと、With シート。 これは、そのシートを参照するわけだけど、「アクティブ」になるわけではない。 逆に言えば、後ろのほうに隠れているシートでも、この記述で処理できる。 もし、このシートを、操作者の目に触れさせたいということなら、With ではなく そのブック.Activate そのシート.Activate (または そのシート.Select) この２行が必要。（で、そのブックとは、Thisworkbookではなく、DataBook なのでは？）
ところで、そちらで作成したフォームによる操作で、「やっぱりやめた」というのは、ないんだよね。 つまり、当該シートに直接入力しているよね。なので、「やっぱりやめた」ということができない仕組みになっている。 こちらで提供したフォームでは、「更新」ないしは「実行」して初めてシートができたりシートに書き込まれたりする。 それらボタンをおさずにフォームを閉じれば、（保存はされるけど）フォーム表示前の状態が維持される。
＞ThisWorkbook.Worksheets("商品マスタ")
＞これは、マクロブックのシートである"商品マスタ"を相手にしている。
すみません、マクロブックではなくデータブックの方にあります… 書き方自体がおかしいんですね…orz ちなみにこれは書いていただいたコードにもある「商品一覧」なんですが、マクロブックの方に置いても大丈夫なのでしょうか？ 在庫管理時には使わないシートなのでマクロブックの方に置いていてもいいのですが、書いていただいたコードに 関係してくるならデータブックに置いておきます。
＞で、そのブックとは、Thisworkbookではなく、DataBook なのでは？
はい、その通りです… 操作者の目に触れさせたいというわけではなく、ユーザーフォームから転記させたいだけなんです またおかしな表現になってしまいました
＞そちらで作成したフォームによる操作で、「やっぱりやめた」というのは、ないんだよね。 ＞当該シートに直接入力しているよね
これは出荷指示リストをワークシートに手打ちしているか、ということでしょうか。 最初リストは直接入力していたのですが商品が多くなった時に分かりにくいとか一画面で処理したいとか要望が 出たので上記の出荷フォームを作って、出荷指示リストに転記するようにしたものです。 入力ミスなどはシートの方を直接修正しています。
ユーザーフォームで転記しているだけで出荷指示シートのレイアウトなどは変更していません。
（らんきち）
>ちなみにこれは書いていただいたコードにもある「商品一覧」なんですが、マクロブックの方に置いても大丈夫なのでしょうか？
マクロブック内においたほうが運用上、好ましいということなら、マクロブックのシートにしよう。 私がアップしたコードの中に４ヶ所 Sheets(shn商品一覧) というところがあるので、これを ThisWorkbook.Sheets(shn商品一覧) に変更すればＯＫ。
ただし、こうすると、商品登録はデータブックを使わないわけなので、この呼び出しプロシジャでは If Not IsOpen Then Exit Sub が不要。消してください。
>操作者の目に触れさせたいというわけではなく、ユーザーフォームから転記させたいだけなんです
であれば、今のままでＯＫだと思うんだけど？ ユーザーフォームでの入力がシートに「反映しない」ということ？
●With ThisWorkbook.Worksheets("商品マスタ") にブレークポイントを設定して操作。
HinTouroku をクリックすると、ここが黄色くなって止まるので、その後、Ｆ８をおしながら
処理を進めて End With が黄色くなったタイミングでマクロブックの商品一覧を見て。
値が書き込まれているかどうか？
★別件で、ＡＢＣという商品をいれた、次にＸＹＺという商品をいれた。 で、その次に、またＡＢＣという商品をいれた。この場合、重複エラーにはならないけどいいの？
>これは出荷指示リストをワークシートに手打ちしているか、ということでしょうか。
いやいや、そうではなく、ユーザーフォームのテキストボックスで入力して HinTouroku をクリックすると 書き込まれるよね。で、最後は、TourokuCls をクリックしてフォームを閉じるわけだけど、心配したのは 操作者の認識として、TourokuCls をクリックしたらシートに反映。やっぱりやめたという時には、 TourokuCls をクリックせず、フォームのＸボタンで閉じる、そうするとシートへの反映はされないと そういうふうに理解していると、困るねということ。 これについては、老婆心だったみたいだね。忘れてください。
(ぶらっと)
ありがとうございます。
商品一覧をマクロブックに置きました。 そうすると商品登録のユーザーフォームの問題は片付いたのですが、別の問題が発生しました…
もう一つの自作フォーム「出荷指示入力」の方で、出荷する商品をコンボボックスで選ぶようにしていて、 商品が増えてもいいように「商品一覧」の商品名略称列（C列）を参照していたのですが、商品一覧をマクロブックに 移したことで参照ができなくなりました…
Private Sub UserForm_Initialize()
'商品名のドロップダウンリスト設定
SyukkaForm.putSyukkaDate.Value = Date
Dim g0 As Long
Dim lRow As String
With ThisWorkbook.Worksheets("商品マスタ")
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
For g0 = 1 To 8
With Controls("putSyohin" & g0)
.ColumnWidths = "50"
.RowSource = ThisWorkbook.Worksheets("商品マスタ!C2:C") & lRow ←ここでエラーになる
End With
Next
End Sub
あと、転記ができない件ですが、ユーザーフォームに入力すると、データブックでたまたま開いているシート（アクティブになっているシート）に 書き込まれてしまうんです。 なので最初に書き込みたいシート（「出荷依頼フォーム」であれば「出荷依頼」シート））を開いておけば そこに書き込まれますが、その他のシートを開いているとそのシートに書き込まれてしまって…
今の段階では上記のように商品参照の時点でエラーになるのでブレークポイントの確認はできませんでした
＞★別件で、ＡＢＣという商品をいれた、次にＸＹＺという商品をいれた。 ＞で、その次に、またＡＢＣという商品をいれた。この場合、重複エラーにはならないけどいいの？
いえ、あまりよくないですが私の知識がこの程度のチェックしかできなくて… 本来なら全体の重複チェックはしたいです（今のところ商品が少ないのでなんとかなっていますが）
（らんきち）
>.RowSource = ThisWorkbook.Worksheets("商品マスタ!C2:C") & lRow ←ここでエラーになる
.RowSource = "商品マスタ!C2:C" & lRow
>あと、転記ができない件ですが、ユーザーフォームに入力すると、データブックでたまたま開いているシート >（アクティブになっているシート）に 書き込まれてしまうんです。
商品登録ではなく、こちらの出荷依頼入力だったんだね。 ここの、書き込んでいるところのコードをアップして。 想像：With でシートを指定しているけど、その下でセルに書き込んでいるところのセルに .(ピリオド）が つけられていないとか？
>本来なら全体の重複チェックはしたいです（今のところ商品が少ないのでなんとかなっていますが）
以下のように。
Dim ck As Variant
With ThisWorkbook.Worksheets("商品マスタ")
If IsNumeric(Application.Match(txtShohinId.Text, .Columns("A"), 0)) Then
MsgBox "商品IDが重複しています"
Exit Sub
End If
lRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Cells(lRow, "a").Value = txtShohinId.Text
.Cells(lRow, "b").Value = txtSyohinmei.Text
.Cells(lRow, "c").Value = txtHinRyaku.Text
End With
(ぶらっと)
＞.RowSource = "商品マスタ!C2:C" & lRow
これに書き換えましたが 「実行時エラー'380' RowSourceプロパティを設定できません。プロパティの値が無効です」 のエラーが出ます。
書き込んでいるコードは下記の通りです。
Private Sub Nyuryoku_Click()
'出荷日に日付型をセット
Dim Hiduke As Date
If IsDate(putSyukkaDate.Text) = True Then
Hiduke = Format(putSyukkaDate.Text, "yyyy/mm/dd")
putSyukkaDate.Text = Hiduke
Else
MsgBox "日付はyyyy/m/dで入力してください", vbInformation
Exit Sub
End If
'出荷依頼シートへの転記
Dim g0 As Long
Dim lRow As String
Dim code1 As String, code2 As String
Dim Ctrl As Control
With ThisWorkbook.Worksheets("出荷依頼")
lRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
code1 = .Cells(lRow, "A").Value
code2 = putTensoNo.Text
If code1 = code2 Then
MsgBox "出荷コードが入力されていません"
Exit Sub
End If
For g0 = 1 To 5
If Controls("putSyohin" & g0) = "" Then Exit For
.Cells(lRow, "a").Value = putTensoNo.Text
.Cells(lRow, "b").Value = Controls("putSyohin" & g0).Value
.Cells(lRow, "c").Value = Controls("putSyukkasu" & g0).Value
.Cells(lRow, "d").Value = putSyukkaDate.Text
lRow = lRow + 1
Next g0
End With
For Each Ctrl In Me.Controls
If Ctrl.Name Like "put*" Then
Ctrl.Value = ""
SyukkaForm.putSyukkaDate.Value = Date
End If
Next
End Sub
ピリオドおかしいでしょうか…
（らんきち）
>これに書き換えましたが >「実行時エラー'380' RowSourceプロパティを設定できません。プロパティの値が無効です」 のエラーが出ます。
実行時点で、商品一覧が属するブック（つまりマクロブック）がアクティブブックじゃないとエラーになるけど きっと、データブックが前面にあったんだろうね。 RowSourceを使うなら、コードで直前にデータブックをActivateする手もあるけど、あまり美しくないね。 RowSourceを使わず、Listを使って以下にしてはいかが？
Dim g0 As Long
Dim lRow As String
Dim v As Variant
With ThisWorkbook.Worksheets("商品マスタ")
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
v = .Range("C2:C" & lRow).Value
End With
For g0 = 1 To 8
With Controls("putSyohin" & g0)
.ColumnWidths = "50"
.List = v
End With
Next
>ピリオドおかしいでしょうか…
コードを見る限りは、おかしくないけど、書き込まれないんだよね。（というか、別のシートに書き込まれる）
やはり、先にコメントしたように、With Worksheets("出荷依頼") にブレークポイント設定して
Ｆ８でステップ実行して、書き込みごとに、出荷依頼シートを確認してみよう。
えっ？そちらでアップしなおしたコード。With ThisWorkbook.Worksheets("出荷依頼")
出荷依頼シートもマクロブックにあるの？（それでもいいけど、それなら、こちらが提供したコードでも
商品一覧シート同様の手当てをお願い）
ところで、lRow = .Range("A" & Rows.Count).End(xlUp).Row + 1 結果的にはエラーにならないけど
本来なら、lRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1 と Rowsの前にもピリオドは必要。
ピリオドがない場合は、たまたま、その時にアクティブなシートのRows.Countが採用される。
(2003ブック,2007以降ブックが混在してエクセル内に存在しない限りはどのシートのRows.Countも、同じ値だけど）
＞出荷依頼シートもマクロブックにあるの？
いいえ、データブックにあります。
書き換えていただいたコードで商品一覧は参照できました。 それでブレークポイントを設定してステップ実行してみましたが、
With ThisWorkbook.Worksheets("出荷依頼")
ここで「インデックスが有効範囲にありません」のエラーが出ます…
lRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
に書き換えましたがやはり上記のところでエラーになって進みません。
またどこかがおかしいんですよね…
（らんきち）
すみません、自分のアホな間違いに気がつきました…
With ThisWorkbook.Worksheets("出荷依頼")
これがそもそもおかしかったんですね
With Worksheets("出荷依頼")
これでうまくいきました 自分でも混乱して何をどこに指定するのか分からなくなっていました。
お手数をおかけいたしました…
（らんきち）
すみません、余計な手を加えたらエラーが出るようになりました…
入荷入力の画面に「コメント欄を入れてほしい」と言われたので、UserForm2にTextBox5を置き、コメント欄としました。 その際にコメント欄を入れられるようにコードをいじったところ、引当更新時にModule4出荷引当実行の
io商品 fnAllocate, cd, comAbbr, qty, dl, lot, syomi
この syomi のところで「ByRef引数の型が一致しません」とエラーが出ます。 いじったのはコメント用の変数を入れたりしただけで syomi のところを扱ったつもりはなかったのですが何か 私の追加したコードが悪さをしているのでしょうか…
追加したのは下記の部分です。(come = コメント欄、文字列型）
ユーザーフォーム2
Private Sub CommandButton1_Click()
Dim comAbbr As String
Dim dlDate As String
Dim syomi As String
Dim lot As String
Dim qty As String
Dim idx As Long
Dim delFlag As Boolean
Dim come As String
comAbbr = ComboBox1.Value
dlDate = TextBox1.Value
syomi = TextBox2.Value
lot = TextBox3.Value
qty = TextBox4.Value
come = TextBox5.Value
ng = False
If Len(TextBox2.Value) + Len(TextBox3.Value) + Len(TextBox4.Value) = 0 _
And updMode Then delFlag = True
If Not delFlag Then
If Not IsNumeric(qty) Then NGSet TextBox4, "入荷数量を正しく入力してください"
If lot = "" Then NGSet TextBox3, "ロットNOは必須です"
If Not IsDate(syomi) Then NGSet TextBox2, "賞味期限を正しく入力してください"
If Not IsDate(dlDate) Then NGSet TextBox1, "出荷日を正しく入力してください"
If comAbbr = "" Then NGSet ComboBox1, "商品が選択されていません"
End If
If ng Then Exit Sub
skip = True
If delFlag Then
ListBox1.RemoveItem updIndex
Else
If updMode Then
idx = updIndex
Else
ListBox1.AddItem
idx = ListBox1.ListCount - 1
End If
End If
ListBox1.List(idx, 0) = TextBox2.Value
ListBox1.List(idx, 1) = TextBox3.Value
ListBox1.List(idx, 2) = TextBox4.Value
ListBox1.List(idx, 3) = TextBox5.Value
skip = False
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
TextBox5.Value = ""
updMode = False
CommandButton1.Caption = "追加"
TextBox2.SetFocus
End Sub
Private Sub CommandButton2_Click()
Dim i As Long
Dim v As Variant
Dim comAbbr As String
Dim syomi As Date
Dim lot As String
Dim qty As Long
Dim dl As Date
Dim come As String
If Len(TextBox2.Value) + Len(TextBox3.Value) + Len(TextBox4.Value) > 0 Then
If MsgBox("入力項目がまだリストに反映していませんが無視していいですか？", vbYesNo) = vbNo Then Exit Sub
End If
If ListBox1.ListCount = 0 Then
MsgBox "まだ入荷入力がなされていません"
Exit Sub
End If
v = ListBox1.List
For i = LBound(v, 1) To UBound(v, 1)
comAbbr = ComboBox1.Value
dl = TextBox1.Value
syomi = v(i, 0)
lot = v(i, 1)
qty = v(i, 2)
come = v(i, 3)
Call io商品(fnPut, comAbbr:=comAbbr, qty:=qty, dlDate:=dl, come:=come, lot:=lot, syomi:=syomi)
Next
Call io商品(fnSort, comAbbr:=comAbbr)
Call Reset
MsgBox "処理が終了しました"
End Sub
Private Sub Reset()
TextBox1.Value = Date
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
TextBox5.Value = ""
With ListBox1
.Clear
.Tag = ""
End With
updMode = False
ComboBox1.SetFocus
End Sub
モジュール１ 宣言部
Public Const 商品略称セル As String = "A1" Public Const 商品名セル As String = "B1" Public Const 開始Row As Long = 3 Public Const 商品IDCol As String = "A" Public Const 履歴開始Col As String = "R" Public Const 履歴終了Col As String = "AR" Public Const 指示PMCol As String = "O" Public Const 指示PM2Col As String = "P" Public Const 引当可能Col As String = "I" Public Const 保留Col As String = "C" Public Const 賞味期限Col As String = "D" Public Const コメントCol As String = "E" Public Const ロットCol As String = "F" Public Const 入荷日col As String = "B" Public Const 入荷数量col As String = "G"
モジュール2
Function io商品(fc As func, Optional cd As String, Optional comAbbr As String, _
Optional qty As Long, Optional dlDate As Date, _
Optional come As String, Optional lot As String, Optional syomi As Date) As Variant
Static dicM As Object
Dim first As Boolean
Dim c As Range
Dim sh As Worksheet
Dim comID As String
Dim comName As String
Dim dKey As Variant
Dim reqQty As Long
Dim dDate As Date
Dim dQty As Long
Dim dLot As String
Dim v() As Variant
Dim setQty As Long
Dim wk As Variant
Dim i As Long
Dim d保留 As Variant
Dim d賞味期限 As Variant
Dim dロット As Variant
Dim d引当可能 As Variant
Dim dコメント As Variant
Dim dm As Long
Dim w As Variant
Dim x As Long
Dim myCol As Long
Dim myflag As Boolean
Dim minQ As Long
Dim maxQ As Long
Dim addFlag As Boolean
Select Case fc
Case fnOpen
Set dicM = CreateObject("Scripting.Dictionary")
For Each sh In Worksheets
If Left(sh.Name, 2) = "在庫" Then
comAbbr = Mid(sh.Name, 3)
Set dicM(comAbbr) = CreateObject("Scripting.Dictionary")
For Each c In sh.Range(商品IDCol & 開始Row, sh.Range(商品IDCol & sh.Rows.Count).End(xlUp).Offset(-2))
i = c.Row
With sh
d保留 = .Cells(i, 保留Col).Value
d賞味期限 = .Cells(i, 賞味期限Col).Value
dコメント = .Cells(i, コメントCol).Value
dロット = .Cells(i, ロットCol).Value
d引当可能 = .Cells(i, 引当可能Col).Value
End With
If Len(d保留) = 0 And Len(d賞味期限) > 0 Then '保留マーク空白/賞味期限あり
dicM(comAbbr)(dicM(comAbbr).Count + 1) = Array(d賞味期限, dロット, d引当可能)
End If
Next
End If
Next
Case fnGetList
Case fnPut
If Not IsObject(Evaluate("'在庫" & comAbbr & "'!A1")) Then
ThisWorkbook.Sheets(tpl商品在庫).Copy After:=Sheets(Sheets.Count)
addFlag = True
With Sheets(Sheets.Count)
.Visible = True
.Name = "在庫" & comAbbr
.Unprotect
End With
End If
With ThisWorkbook.Sheets(shn商品一覧)
x = WorksheetFunction.Match(comAbbr, .Columns(ABBRCol), 0)
comName = .Cells(x, NameCol).Value
comID = .Cells(x, IDCol).Value
End With
With Sheets("在庫" & comAbbr)
.Range(商品略称セル).Value = comAbbr
.Range(商品名セル).Value = comName
If addFlag Then
x = 開始Row
Else
x = .Range(商品IDCol & .Rows.Count).End(xlUp).Row - 1
.Rows(x).Insert shift:=xlDown
.Rows(x - 1).Copy
.Rows(x).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.Rows(x).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
On Error Resume Next
Set c = .Rows(x).SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If Not c Is Nothing Then c.ClearContents
Set c = Nothing
End If
.Cells(x, 商品IDCol).Value = comID
.Cells(x, 入荷日col).Value = dlDate
.Cells(x, 賞味期限Col).Value = syomi
.Cells(x, コメントCol).Value = come
.Cells(x, ロットCol).Value = lot
.Cells(x, 入荷数量col).Value = qty
End With
fnAllocate の部分は触っていません。
入荷時のコメント入力はうまくいっています。
何が原因なんでしょうか…
本当にたびたびすみません…
（らんきち）
先に結論を言えば、io商品側のパラメータ記述に追加した Optional come As String の位置が悪い。 これは、最後のパラメータにする。（もちろん、追加した位置を「正」とすることもできるけど、その場合は io商品を「定位置パラメータ」記述で使っているところ、たとえば io商品 fnAllocate, cd, comAbbr, qty, dl, lot, syomi これを修正しておかなければいけない。
サブプロシジャの引数は、原則、「定位置パラメータ」（Positional Parameter) といわれるもので たとえば、 Sub XYZ(a,b,c,d) なんてのがあったとして、これを使う場合は
Call XYZ(aa,bb,cc,dd) ないしは XYZ aa,bb,cc,dd とする。 aaはaにあたるもの、bbはbにあたるもの・・・・これらを、プロシジャ側で規定した順番で記述する必要がある。 でも、io商品のように、様々な機能で使う場合、必ずしもすべての引数が必要じゃない場合もある。 このような時、サブプロシジャ側を たとえば Sub XYZ(a,Optional B,Optional C,Optional d) と規定。 引数 a は必須だけど、b,c,dは任意と宣言。この場合、使う側としては、たとえば Call XYZ(aa,,,dd) と b,cを省略できる。この例は、引数の数も少ないので ,,,で記述したけど、一般には「キーワードパラメータ」記述を行う。 つまり、 Call XYZ(aa,d:=dd) 引き数名に:をつけたもので指定。このほうが書きやすいしコードをみてもわかりやすいよね。
で、本題。
そちらで、io商品側を
Function io商品(fc As func, Optional cd As String, Optional comAbbr As String, _
Optional qty As Long, Optional dlDate As Date, _
Optional come As String, Optional lot As String, Optional syomi As Date) As Variant
このようにしたね。
すると、６番目の引数はOptional come As String、７番目がOptional lot As String、８番目がOptional syomi As Date
ところが、これを使う側が、定位置パラメータ記述方式の io商品 fnAllocate, cd, comAbbr, qty, dl, lot, syomi (1) (2) (3) (4) (5) (6) (7) ７番目のsyomiは日付型。一方、io商品側は７番目が String(文字列) だから「型が一致しません」
(ぶらっと)
↑ io商品側の引数の記述順をそのままにするなら、 io商品 fnAllocate, cd, comAbbr, qty, dl,,lot, syomi と、ここをなおしてもいい。
(ぶらっと)
本当に無知で申し訳ありません…
io商品の引数の順番を変えて（Optional come As Stringを最後に持って行って）うまくいきました
定位置パラメータというものが分かっていませんでした 適当に扱ってしまってすみません ありがとうございます
（らんきち）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.