| |
>ただ、本当は、A列の明細番号は1〜18までありまして、17行目から34行目までが、
>納品書の明細入力欄でして、B17に一つ、コンボボックスを配置して、17行目に転記入力、
>B18に一つ、コンボボックスを配置して、18行目に転記入力、というように、
>18個のコンボボックスで、17行目から34行目まで、それぞれのコンボボックスを使用して、
>1行ずつ、転記入力できるようにしたいのです。
>
>それをとりあえず､17行目と18行目にもコンボボックスを作って､やってみたのですが､
>以下のエラーが出てしまいました｡
>「コンパイルエラー：
>End Sub、End Function または End Property以降には、コメントのみが記述できます。」
>そして､一番先頭のこの部分が､
>Private Sub cbo商品一覧1_Change()
>黄色く表示されます｡
>コンボボックスの名前は､cbo商品一覧1と､cbo商品一覧2としました｡
>以下が､コードになります｡
と言う事なら、最初からこうしたいと言って欲しかったのですが？
コード中の転記部分は全て同じなので、別プロシージャとして転記は、
此れを呼び出す様にします
また、各ComboBoxのイベントプロシージャの中も成るべく簡単にしました
Posting（転記プロシージャ）を呼び出すときの渡す第1引数は、出力先の行位置とします
また、第2引数は転記元の行位置とします
'★以下のステートメントはモジュール先頭に1回だけ宣言する
'多分、此れを幾つも宣言した為
'「End Sub、End Function または End Property以降には、コメントのみが記述できます。」
'が出たと思います
Option Explicit
Private Sub cbo商品一覧1_Change()
Dim lngRow As Long
'cbo商品一覧1のListIndexを取得
lngRow = cbo商品一覧1.ListIndex
'ComboBoxで選択されていない場合
If lngRow = -1 Then
Exit Sub
End If
'転記 以下のプロシージャ呼び出しで
'17は17行目を意味します
'また、lngRow + 5はComboBoxのListIndex+5を意味します
Posting 17, lngRow + 5
End Sub
Private Sub cbo商品一覧2_Change()
Dim lngRow As Long
'cbo商品一覧2のListIndexを取得
lngRow = cbo商品一覧2.ListIndex
'ComboBoxで選択されていない場合
If lngRow = -1 Then
Exit Sub
End If
'転記 以下のプロシージャ呼び出しで
'18は18行目を意味します
'また、lngRow + 5はComboBoxのListIndex+5を意味します
Posting 18, lngRow + 5
End Sub
Private Sub cbo商品一覧3_Change()
Dim lngRow As Long
'cbo商品一覧3のListIndexを取得
lngRow = cbo商品一覧3.ListIndex
'ComboBoxで選択されていない場合
If lngRow = -1 Then
Exit Sub
End If
'転記 以下のプロシージャ呼び出しで
'19は19行目を意味します
'また、lngRow + 5はComboBoxのListIndex+5を意味します
Posting 19, lngRow + 5
End Sub
'★下記プロシージャは、上記イベントプロシージャと同じシートモジュールに記述
Private Sub Posting(lngWrite As Long, lngRow As Long)
'転記
With Worksheets("MT_商品")
Me.Cells(lngWrite, "B").Value = .Cells(lngRow, "A").Value
Me.Cells(lngWrite, "C").Value = .Cells(lngRow, "B").Value
Me.Cells(lngWrite, "D").Value = .Cells(lngRow, "C").Value
Me.Cells(lngWrite, "E").Value = .Cells(lngRow, "D").Value
Me.Cells(lngWrite, "F").Value = .Cells(lngRow, "E").Value
Me.Cells(lngWrite, "H").Value = .Cells(lngRow, "F").Value
Me.Cells(lngWrite, "J").Value = .Cells(lngRow, "G").Value
Me.Cells(lngWrite, "K").Value = .Cells(lngRow, "H").Value
Me.Cells(lngWrite, "P").Value = .Cells(lngRow, "I").Value
Me.Cells(lngWrite, "Q").Value = .Cells(lngRow, "J").Value
End With
End Sub
|
|
Hirofumi
- 10/3/26(金) 17:31 -
