VBA 仕入管理4(Worksheet_SelectionChange)

Worksheet_Change(ByVal Target As Range)・・・End sub
VBAシステム(仕入管理1)
VBAシステム(仕入管理2)
VBAシステム(仕入管理3)
につづいて
Worksheet_SelectionChange(ByVal Target As Range)・・・End sub
を解説していきます。
・Worksheet_Changeはワークシートのセル内容変更があったときにプログラムが実行されます。
・Worksheet_SelectionChangeセルの選択が現在のセルから他のセルに変更されたときにプログラムが実行されます。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Application.EnableEvents = False
  cr1 = Target.Row
  cc1 = Target.Column
‘伝票日付の取得
If cr1 = 5 And cc1 = 5 Then
  Cells(cr1, cc1) = Mid(Date, 1, 4) & Mid(Date, 6, 2) & Mid(Date, 9, 2)
End If
‘納期
If cr1 = 5 And cc1 = 15 Then
  CalenderS
End If
‘候補選択
If cc1 = 1 And cr1 > 4 Then
  If Cells(cr1, cc1).Value <> “” Then
    Select Case Cells(4, 1).Value
    Case “納期”
      Cells(5, 15).Value = Cells(cr1, cc1).Value
    Case “商品CODE”
      ClrForm
      ’CODEで仕入商品呼出
      cnt = UCase(Target.Value)
      PickC1 (cnt)
    End Select
  End If
End If
‘進捗状況の変更
If cc1 = 17 Then
  If cr1 > 6 And cr1 < 33 Then     
    Select Case Cells(cr1, cc1).Value
    Case “注文書発行”
      Cells(cr1, cc1).Value = “入荷済”
      Cells(cr1, cc1 – 2).Value = Mid(Date, 1, 4) & Mid(Date, 6, 2) & Mid(Date, 9, 2)

    Case “入荷済”
      Cells(cr1, cc1).Value = “発注予約”
    Case “発注予約”
      Cells(cr1, cc1).Value = “注文書発行”
    End Select
    Cells(cr1, cc1 + 1).Select
  End If
End If
Application.EnableEvents = True

End Sub

動作の説明

1. カーソルがE5セルに移動したときに伝票日付の欄に今日の日付を取得します。
2. カーソルがO5セルに移動したときに納期の候補がA6セル以下に表示されます。(下図の状態)

3. A6セル以下に候補がリストアップされた状態で納期や商品CODEを選択すると入力欄に転記します。(下図ではA16セルをクリック、納期がO5セルに転記)

4. Q列7行目から33行目までのセルを選択すると“入荷済” ⇒”発注予約”⇒”注文書発行”とテキストが変更されます。

一節ずつ解説します。

Target

cr1 = Target.Row
cc1 = Target.Column

現在選択しているセルのTarget.Rowは行、Target.Columnは列の値を取得します。

日付の取得

‘伝票日付の取得
If cr1 = 5 And cc1 = 5 Then
  Cells(cr1, cc1) = Mid(Date, 1, 4) & Mid(Date, 6, 2) & Mid(Date, 9, 2)
End If

IF文でセルの移動先が5行5列であることを確認して処理を実行します。
次に日付を文字列として変換しています。今日が2022年4月1日としてDateは2022/04/01、Mid(Date, 1, 4) & Mid(Date, 6, 2) & Mid(Date, 9, 2)は”20220401″となります。
Mid(Date, 1, 4)は2022/04/01を1文字目から4文字で“2022”
Mid(Date, 6, 2)は2022/04/01を6文字目から2文字で“04”
Mid(Date, 9, 2)は2022/04/01を9文字目から2文字で“01”
それを&で結んで”20220401″となります。
Range(“E5”).Value = でE5セルに”20220401″を代入します。

‘納期日付の取得
If cr1 = 5 And cc1 = 15 Then
  CalenderS
End If

IF文でセルの移動先が5行15列であることを確認して処理を実行します。
CalenderSで納期候補がA6セル以下に表示されます。 プロジャーCalenderSの内容は後で記述します。

値の代入

‘候補選択
If cc1 = 1 And cr1 > 4 Then
  If Cells(cr1, cc1).Value <> “” Then
    Select Case Cells(4, 1).Value
    Case “納期”
      Cells(5, 15).Value = Cells(cr1, cc1).Value
    Case “商品CODE”
      ClrForm
      ’CODEで仕入商品呼出
      cnt = UCase(Target.Value)
      PickC1 (cnt)
    End Select
  End If
End If

1. IF文でセル選択先が1列目、4行目以降であること、
2. IF文でセル選択先テキストが””、でないことを確認してSelect文に入っていきます。
3. 1列目、4行目のセル内容が“納期”であれば、選択した納期がCells(5, 15)O15セルに転記されます。
4. 1列目、4行目のセル内容が“商品CODE”であればPickC1 (cnt)が呼び出され、選択した商品情報が転記されます。
4.の処理はWorksheet_Change(ByVal Target As Range)・・・End sub
VBAシステム(仕入管理3)pickC2で1列5行目以降に商品リストが作成されていることが前提となります。

Select Case

‘進捗状況の変更
If cc1 = 17 Then
  If cr1 > 6 And cr1 < 33 Then     
   Select Case Cells(cr1, cc1).Value     
    Case “注文書発行”
      Cells(cr1, cc1).Value = “入荷済”
      Cells(cr1, cc1 – 2).Value = Mid(Date, 1, 4) & Mid(Date, 6, 2) & Mid(Date, 9, 2)

    Case “入荷済”
      Cells(cr1, cc1).Value = “発注予約”
    Case “発注予約”
      Cells(cr1, cc1).Value = “注文書発行”
    End Select
    Cells(cr1, cc1 + 1).Select
  End If
End If

1. IF文でセル選択列が17列目であること、
2. IF文でセル選択行が15行目から32行目内であること、
を確認してSelect Case構文処理を行います。
3. Cells(cr1, cc1 + 1).Selectでセル選択先をひとつ横に移動します。

Select Case構文について解説します。
・Select Case Cells(cr1, cc1).Valueで選択したセルのテキストを評価します。

・Case “注文書発行”
   Cells(cr1, cc1).Value = “入荷済”
でテキストが”注文書発行”である場合”入荷済”に上書きします。

今日の日付を入荷日としてCells(cr1, cc1 – 2).Value 2列前の納期欄に上書きしています。

・Case “入荷済”
   Cells(cr1, cc1).Value = “発注予約”
でテキストが”入荷済”である場合”発注予約”に上書きします。

・Case “発注予約”
   Cells(cr1, cc1).Value = “注文書発行”
でテキストが”発注予約”である場合”注文書発行”に上書きします。

・End Select
でSelect Caseを終了します。

Cells(cr1, cc1 + 1).Selectはカーソルをひとつ横に移動させています。
Worksheet_SelectionChangeではカーソルの移動でプログラムが実行されます。
そのため連続して同じセルをクリックしてもプログラムは実行されません。
同じセルの値を”入荷済”⇒”発注予約”⇒”注文書発行”と変更させるために自動的に一つ横に移動させカーソルを元の位置に戻すことでWorksheet_SelectionChangeイベントを発生させています。

CalenderS

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Sub CalenderS()
ClrList
  Cells(4, 1).Value = “納期”
  Cells(4, 2).Value = “曜日”
  Cells(4, 3).Value = “”
  Cells(4, 4).Value = “”
For h = 0 To 30
  Cells(6 + h, 1).Value = Mid(DateAdd(“d”, h, Date), 1, 4) & Mid(DateAdd(“d”, h, Date), 6, 2) & Mid(DateAdd(“d”, h, Date), 9, 2)
  Cells(6 + h, 2).Value = WeekdayName(Weekday(DateAdd(“d”, h, Date)), True)
Next
End Sub

ClrListで入力候補リスト表示欄をクリアします。
4行目1列に納期、2列目に曜日、3,4列目に空欄を代入します。
For・・・Next文で0から30まで約一か月分の
日付を1列目、曜日を2列目、6行目以降に表示します。
Mid(DateAdd(“d”, h, Date), 1, 4)はDateAdd(“d”, h, Date)部分で今日の日付Dateにhを足していきます。“d”では日を加算、“d”“yyyy”に変えると“m”に変えるとが加算されます。
Mid(…,1,4)は日付から西暦年数を文字列で取り出しています。詳しくは上述した日付の取得を参照してください。
WeekdayName(Weekday(DateAdd(“d”, h, Date)), True)は曜日を取得しています。最後のTRUEで表示形式”月、火、水、木、金、土”を選択しています。
Falseだと”曜日”が付きます。

実際にVBE画面に打ち込み動作を確認してください。

続いて登録ボタンのmoduleを作成していきます。

タイトルとURLをコピーしました