FC2ブログ

スポンサーサイト 


上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

採番する 


レコードを新規登録する時の採番方法として、以下のルールがあるものと仮定します。

・先頭1文字が "D" または "E"
・次の6文字が "yymmdd"
・次の2文字が " A" ~ " Z"、"AA" ~ "AZ"、"BA" ~ "BZ"、・・・・

例えば、"D111126 A" とか・・・
もちろんのこと、日付が変われば 最後の文字は "A" に戻って・・・

この確認用のフォームとして、以下の様なものを作りました。
kEnt105

いつの時点で採番するのか・・・・選択にオプショングループ「op1」
(「挿入前」「更新前」「新規移動」の3つに着目)
頭の文字選択用にオプショングループ「op2」
何日用の採番をするのか、テキストボックス「txt1」
(ここでダブルクリックすると日付入力支援フォームが・・・)

用意したフォームは「F1」~「F4」の4つですが、フォームを構成するものは同じです。
中での記述がチョコチョコと異なります。
各フォームで入力できるところは、「数量」のみとなってます。
 
まず、採番する方法は共通なので、標準モジュールに以下を記述しておきます。
Private Function GetNewSeq(dt As Date _
        , sHead As String, sField As String, sTable As String) As String
  Dim sS As String
  Dim sW As String, S1 As String, S2 As String
  Const sDEF As String = " @"
  Const sLMT As String = "Z"

  sS = sHead & Format(dt, "yymmdd")
  sW = sField & " Like '" & sS & "*'"
  sW = Nz(DMax("Right(" & sField & ",2)", sTable, sW), sDEF) '☆1
'  sW = Nz(DMax(sField, sTable, sW), sDEF) '★1
'  sW = Right(sW, 2) '★1
  S1 = Left(sW, 1)
  S2 = Right(sW, 1)
  If (S2 = sLMT) Then
    If (S1 = Left(sDEF, 1)) Then '☆2
      S1 = Right(sDEF, 1) '☆2
    End If '☆2
    S1 = Chr(Asc(S1) + 1) '☆2
    S2 = Right(sDEF, 1) '☆2
  End If
  GetNewSeq = sS & S1 & Chr(Asc(S2) + 1)
End Function

Public Function EgetNewSeq(Optional dt As Date) As String
  EgetNewSeq = GetNewSeq(IIf(dt = 0, Date, dt), "E", "[採番]", "[TA]")
End Function

Public Function DgetNewSeq(Optional dt As Date) As String
  DgetNewSeq = GetNewSeq(IIf(dt = 0, Date, dt), "D", "[採番]", "[TA]")
End Function

ここでのキーポイントは Chr(Asc(S2) + 1) で文字を1つ進めたものを作れる。
Chr(Asc("A") + 1) は "B" になります。
初期の文字として、"A" にするには、"A" の前の "@" を指定してます。
※ ☆1部分では、その日の右2文字の最大を求めていますが、これが嫌なら★1に置換えて・・・
※ ☆2部分で最後の前の文字を作り直しています。


フォーム「F1」

ここでの方法は、
イベントは事前に記述しておいて、オプショングループ「op1」の選択により、
どのイベントを有効とするかを切り換えるものとなります。
各イベントでは、自分が動ける=「op1」の確認は不要・・・・と云う位でしょうか。

記述した VBA は以下
Const EVENT_PROCEDURE As String = "[EVENT PROCEDURE]"

Private Sub Form_Load()
  Me.op1 = 1
  Call op1_Click
End Sub

Private Sub NewSeq()
  Select Case Me.op2
    Case 1: Me.採番 = DgetNewSeq(Nz(Me.txt1))
    Case 2: Me.採番 = EgetNewSeq(Nz(Me.txt1))
  End Select
  Me.更新日 = Now()
End Sub

Private Sub Form_BeforeInsert(Cancel As Integer)
  Call NewSeq
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
  If (Me.NewRecord) Then Call NewSeq
End Sub

Private Sub Form_Current()
  If (Me.NewRecord) Then Call NewSeq
End Sub

Private Sub op1_Click()
  With Me
    Select Case .op1
      Case 1
        .BeforeInsert = EVENT_PROCEDURE
        .BeforeUpdate = ""
        .OnCurrent = ""
      Case 2
        .BeforeInsert = ""
        .BeforeUpdate = EVENT_PROCEDURE
        .OnCurrent = ""
      Case 3
        .BeforeInsert = ""
        .BeforeUpdate = ""
        .OnCurrent = EVENT_PROCEDURE
    End Select
  End With
End Sub

Private Sub txt1_DblClick(Cancel As Integer)
  DoCmd.OpenForm "F_DATE"
  Cancel = True
End Sub

 
ここで確認方法についてチョッと
初期ではデータは入ってません。
ので、「新規移動」を選んでも何も起きません。
何かレコードを登録してもらい、「既存」⇔「新規」を往ったり来たりしてみてください。
「挿入前」では、新規行で数量へ入力を開始した時点で採番します。
「更新前」では、新規行で入力した後(確定する時)に採番します。


フォーム「F2」

フォーム「F1」を動かしてみて感じられたかと思いますが、
「更新前」の時、何が採番されるか入力を確定するまでわかりませんね。
ということで、「更新前」が選ばれていた場合、既定値で表示しておきましょうか・・・

記述した VBA は以下
Const EVENT_PROCEDURE As String = "[EVENT PROCEDURE]"

Private Sub Form_Load()
  Me.op1 = 1
  Call op1_Click
End Sub

Private Sub NewSeq()
  Select Case Me.op2
    Case 1: Me.採番 = DgetNewSeq(Nz(Me.txt1))
    Case 2: Me.採番 = EgetNewSeq(Nz(Me.txt1))
  End Select
  Me.更新日 = Now()
End Sub

Private Sub Form_AfterInsert()
  Select Case Me.op2
    Case 1: Me.採番.DefaultValue = "'" & DgetNewSeq(Nz(Me.txt1)) & "'"
    Case 2: Me.採番.DefaultValue = "'" & EgetNewSeq(Nz(Me.txt1)) & "'"
  End Select
End Sub

Private Sub Form_BeforeInsert(Cancel As Integer)
  Call NewSeq
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
  If (Me.NewRecord) Then Call NewSeq
End Sub

Private Sub Form_Current()
  If (Me.NewRecord) Then Call NewSeq
End Sub

Private Sub op1_Click()
  With Me
    Select Case .op1
      Case 1
        .AfterInsert = ""
        .BeforeInsert = EVENT_PROCEDURE
        .BeforeUpdate = ""
        .OnCurrent = ""
        .採番.DefaultValue = ""
      Case 2
        .AfterInsert = EVENT_PROCEDURE
        .BeforeInsert = ""
        .BeforeUpdate = EVENT_PROCEDURE
        .OnCurrent = ""
        Call Form_AfterInsert
      Case 3
        .AfterInsert = ""
        .BeforeInsert = ""
        .BeforeUpdate = ""
        .OnCurrent = EVENT_PROCEDURE
        .採番.DefaultValue = ""
    End Select
  End With
End Sub

Private Sub op2_Click()
  If (Me.op1 = 2) Then Call Form_AfterInsert
End Sub

Private Sub txt1_DblClick(Cancel As Integer)
  DoCmd.OpenForm "F_DATE"
  Cancel = True
End Sub

Private Sub txt1_AfterUpdate()
  If (Me.op1 = 2) Then Call Form_AfterInsert
End Sub

 
上記の記述で、う~~ん・・・・ってとこありませんでした?
  With Me
    Select Case .op1
      Case 1
        .AfterInsert = ""
        .BeforeInsert = EVENT_PROCEDURE
        .BeforeUpdate = ""
        .OnCurrent = ""
        .採番.DefaultValue = ""
      Case 2
        .AfterInsert = EVENT_PROCEDURE
        .BeforeInsert = ""
        .BeforeUpdate = EVENT_PROCEDURE
        .OnCurrent = ""
        Call Form_AfterInsert
      Case 3
        .AfterInsert = ""
        .BeforeInsert = ""
        .BeforeUpdate = ""
        .OnCurrent = EVENT_PROCEDURE
        .採番.DefaultValue = ""
    End Select
  End With
の With Me ですね。
こういう記述はあまりしませんが覚えておくと結構使えます。
他のフォームから、この「F2」の設定を変えたいとか・・・
そういった場合、例えば
  With Forms("F2")
    Select Case .op1
      Case 1
        .AfterInsert = ""
        .BeforeInsert = EVENT_PROCEDURE
        .BeforeUpdate = ""
        .OnCurrent = ""
        .採番.DefaultValue = ""
      Case 2
        .AfterInsert = EVENT_PROCEDURE
        .BeforeInsert = ""
        .BeforeUpdate = EVENT_PROCEDURE
        .OnCurrent = ""
        Call Form_AfterInsert
      Case 3
        .AfterInsert = ""
        .BeforeInsert = ""
        .BeforeUpdate = ""
        .OnCurrent = EVENT_PROCEDURE
        .採番.DefaultValue = ""
    End Select
  End With
と記述することができます。
同じことをしてますし、With ~ End With で挟まれたものはほとんど同じで大丈夫です。
※ 上記で変更が必要なのは、Call Form_AfterInsert 部分になります。


フォーム「F3」

フォーム「F1」「F2」では、イベントの有効/無効で動きを切り替えてきましたが、
各イベントでオプショングループ「op1」の値を確認すれば良いんじゃない・・・
ってことで。
また、既定値の設定部分をまとめてみました。

記述した VBA は以下
Private Function DefSet()
  Select Case Me.op1
    Case 1, 3
      Me.採番.DefaultValue = ""
    Case 2
      Select Case Me.op2
        Case 1: Me.採番.DefaultValue = "'" & DgetNewSeq(Nz(Me.txt1)) & "'"
        Case 2: Me.採番.DefaultValue = "'" & EgetNewSeq(Nz(Me.txt1)) & "'"
      End Select
  End Select
End Function

Private Sub Form_Load()
  Me.AfterInsert = "=DefSet()"
  Me.op1.OnClick = "=DefSet()"
  Me.op2.OnClick = "=DefSet()"
  Me.txt1.AfterUpdate = "=DefSet()"
End Sub

Private Sub NewSeq()
  Select Case Me.op2
    Case 1: Me.採番 = DgetNewSeq(Nz(Me.txt1))
    Case 2: Me.採番 = EgetNewSeq(Nz(Me.txt1))
  End Select
  Me.更新日 = Now()
End Sub

Private Sub Form_BeforeInsert(Cancel As Integer)
  If (Me.op1 = 1) Then Call NewSeq
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
  If (Me.op1 = 2) Then
    If (Me.NewRecord) Then Call NewSeq
  End If
End Sub

Private Sub Form_Current()
  If (Me.op1 = 3) Then
    If (Me.NewRecord) Then Call NewSeq
  End If
End Sub

Private Sub txt1_DblClick(Cancel As Integer)
  DoCmd.OpenForm "F_DATE"
  Cancel = True
End Sub

 

フォーム「F4」

このフォーム「F4」は、フォーム「F3」でオプショングループ「op2」を判別しているところを
一ヶ所にまとめてみましょうか・・・・

記述した VBA は以下
Private Function GetNewSeq(iNum As Long, dt As Date) As String
  Select Case iNum
    Case 1: GetNewSeq = DgetNewSeq(dt)
    Case 2: GetNewSeq = EgetNewSeq(dt)
  End Select
End Function

Private Function DefSet()
  Select Case Me.op1
    Case 1, 3
      Me.採番.DefaultValue = ""
    Case 2
      Me.採番.DefaultValue = "'" & GetNewSeq(Me.op2, Nz(Me.txt1)) & "'"
  End Select
End Function

Private Sub Form_Load()
  Me.AfterInsert = "=DefSet()"
  Me.op1.OnClick = "=DefSet()"
  Me.op2.OnClick = "=DefSet()"
  Me.txt1.AfterUpdate = "=DefSet()"
End Sub

Private Sub NewSeq()
  Me.採番 = GetNewSeq(Me.op2, Nz(Me.txt1))
  Me.更新日 = Now()
End Sub

Private Sub Form_BeforeInsert(Cancel As Integer)
  If (Me.op1 = 1) Then Call NewSeq
End Sub

Private Sub NewRecNewSeq()
  If (Me.NewRecord) Then Call NewSeq
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
  If (Me.op1 = 2) Then Call NewRecNewSeq
End Sub

Private Sub Form_Current()
  If (Me.op1 = 3) Then Call NewRecNewSeq
End Sub

Private Sub txt1_DblClick(Cancel As Integer)
  DoCmd.OpenForm "F_DATE"
  Cancel = True
End Sub

 
今回サンプルとして、
「挿入前」「更新前」「新規移動」を1つのフォーム上で切り替えれるようにしましたが、
実際にはどれか1つになると思います。
どれか1つ・・・・と言われれば、「挿入前」になるのでしょうか。
でも、今回「更新前」+既定値での方法も使いようがあるかな・・・・
(「更新前」で採番を再取得しているので、既定値を得た時点と変わる可能性もあり・・・)

運用を考えた場合、他の方法を使ったりとか・・・・・


サンプルは以下
 バージョン 20002003 (2002)2007
 ファイル kEnt105_2000.zipkEnt105_2003.zipkEnt105_2007.zip
 サイズ 61,13961,98066,251
※ ファイルは zip 形式
※ 2007 以外は、2007 保存時に変換 & 各バージョンで動作確認 & 最適化

関連記事

2011/11/26

Category: サンプルかな

TB: 0  /  CM: 0

top △

この記事に対するコメント

top △

コメントの投稿

Secret

top △

トラックバック

トラックバックURL
→http://kikutips.blog13.fc2.com/tb.php/105-187de640
この記事にトラックバックする(FC2ブログユーザー)

top △


上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。