|
>初入力時はM33.01.20と表示
こちらでは正しくH19になっていますが・・。
いずけにせよ、セル選択イベントと入力イベントで制御するのは厄介なので、
目的の範囲内のセルを一つ選んで右クリックしたとき、数値を入力する
フォームを出す、というやり方にしてみましょう。
現在シートモジュールに入れているイベントマクロは削除してから、以下を入れて
下さい。これだと書式が消えることはありません。
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, _
Cancel As Boolean)
Dim MyD As Integer, AdM As Integer
Dim CkD As Date, SetD As Date
Const Pmt As String = "日を 1〜31 までの数値で入力して下さい"
With Target
If Intersect(.Cells, Range("B20:B350")) Is _
Nothing Then Exit Sub
If .Count > 1 Then Exit Sub
End With
Cancel = True
Do
MyD = Application.InputBox(Pmt, Type:=1)
If MyD = False Then Exit Sub
Loop While MyD < 1 Or MyD > 31
If Day(Date) >= 23 Then
AdM = 2
Else
AdM = 1
End If
CkD = DateSerial(Year(Date), Month(Date) + AdM, 0)
SetD = DateSerial(Year(Date), Month(Date) + (AdM - 1), MyD)
If Day(CkD) < MyD Then
MsgBox MyD & " 日は存在しません", 48
Else
With Target
.NumberFormat = "ge.mm.dd"
.Value = SetD
End With
End If
End Sub
|
|