[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『「商品の発注依頼について」[カズ] について』（カズ）
投稿
[[20200731133748]] 『商品の発注依頼について』（カズ）
について...解決はしておりますが、今回は発注依頼表から実際に各業者に依頼する発注伝票(別sheet)への転記についての質問です。
現在の発注までの流れは、使用する食材が決まって、その食材をいつまでに注文すれば間に合うかを前回の表で分かるようにしました。
今回の質問ですが、食材発注については在庫を確認し、注文する/しないを決めて、する場合は手入力にて発注伝票に打っております。
この手入力を上手く別sheetに転記できないか、と思いご教授をお願いしたいです。
XX業者発注依頼表
行 ____A____ _B_ _C_ __D__ _ E _ ___ F ___ __G__ __H__ _ I _ _ J _ __K__ __ L __ __M__ _N_ O P Q _R_ _S_ _T_ ______BC______ ___BD___ ____BE____
1 ××業者 0001011
2 2/20 2/21 2/22 2/23 2/24 2/25 2/26 2/27 2/28 2/29 3/1 3/2 3/3 3/4 3/5 3/6 3/7 祝日一覧 業者名 休パターン
3 木 金 土 日 月 火 水 木 金 土 日 月 火 水 木 金 土 2020/1/1(水) 〇〇業者 0000000
4 豚レバー 50 2020/1/13(月) ××業者 0001011
5 商品No Kg ○ 2020/2/11(火) △△業者 0101011
6 在庫管理 40 2020/2/23(日)
7 中3日 3 3/6 2020/2/24(月)
8 牛バラ 60 2020/3/20(金)
9 商品No Kg ○ 2020/4/29(水)
10 在庫管理 30 2020/5/3(日)
11 中2日 2 3/4 2020/5/4(月)
2020/5/5(火)
XX業者発注伝票 (下記の伝票に転記する)
A B C D E F G H
1 年 月 日 2 XX業者発注伝票 3 ○○食堂 4 品名 コード番号 数量 単位 品名 コード番号 数量 単位
5 豚レバー 000578 40 Kg 牛バラ 006789 30 Kg 6 ○○ 000998 25 kg ○○ 124568 35 kg 7 | 8 | | 45
転記する情報は
・実際の発注数は依頼表の在庫管理の行に入力します。(○の真下です) ・在庫があり注文しない場合は発注数の代わりに「-」を入れています。 ・ 商品名はリストから選択し、選択すると商品Noと単位は自動で表示されます。 ・ 発注伝票は、毎日発注するたびに消して使うので、発注数量は依頼表の商品名行に書かれた最新の数字になります。 ・ 依頼表の商品名部分（位置）は1か月は変わりません。
発注伝票は
. 上から詰めて転記がしたいです。 ・2列になっているので、できれば右左〜下と転記がしたいです。
連続での質問になり恐縮ですが、どうかご教授をお願いします。
＜ 使用 Excel：Excel2013、使用 OS：Windows10 ＞
ちょっと分からない部分があるんですが、、
発注依頼表は、発注期限を管理する表ですよね？
何の食材をいつ発注するかは、バラバラであるハズなのに 何故、或る１日の発注伝票に全発注食材の一覧が必要なのですか？
（半平太） 2020/08/20(木) 22:07
お世話になります。
確かに、半平太さまが疑問に思う通り発注伝票には各業者毎、全食材の一覧は必要ではありません。
現状では、全食材名が記載されている表に、今回発注する分だけ数量を入力していたので、かなり飛び飛びになったり
しています。
なので、発注伝票はなるべくスッキリさせたいので、当日発注する物だけ記載したいと思います。
発注業者によっては、頻繁に使う食材は同じ食材で毎日発注する物もあるので○が連続する場合や、「しょうゆ」や
「みりん」等一度注文すると、しばらく注文がない物もあります。
なので発注伝票に転記するのは、今日、新しく発注する物だけを転記したいです。
（カズ） 2020/08/21(金) 08:40
＞今日、新しく発注する物だけを転記したいです。
どこを見ると「今日新しく発注する」食材だと分かるんですか？
質問文の通り、発注数量が依頼表の「在庫管理の行」に入力されている食材でいいんですか？ ※発注期限が実際の発注日を過ぎている言うことはないんですね？
（半平太） 2020/08/21(金) 09:17
>どこを見ると「今日新しく発注する」食材だと分かるんですか？
基本、在庫管理行の日付の新しいものになります。
A B C D E F G H I J
2 2/20 2/21 2/22 2/23 2/24 2/25 2/26
3 木 金 土 日 月 火 水
4 豚レバー 50 60
5 商品No Kg ◯ ◯
6 在庫管理 30 25
上記のように、在庫管理行に2/24が30, 2/25が25となる場合は2/25の25が最新となります。基本的に、発注期限が2/25と分かった時点で前もって発注をかけます。なので実際の発注日が発注期限を過ぎる事はありません。
出来れば、発注で転記した場合は、発注済みだと分かるようにセルに色が付けば依頼表が見やすくなります。
すみません。わかりずらくて。宜しくお願い致します。
（カズ） 2020/08/21(金) 19:58
１．後記マクロをThisworkbookモジュールに貼り付ける(つまり、標準モジュールにではない）
２．発注依頼表シートのF1セル(発注業者名)を右クリックする。 └→※１シート目でも、２シート目でも、どちらでも構わない。
３．すると、発注伝票を作成しますか？ と訊いてくるので「はい」で応える
４．すると「業者名＆発注伝票」シートに結果が出る。 当該シートが存在しない場合は、自動的に作成されます。
’Thisworkbookモジュールに貼り付けるマクロ
’↓
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim ws As Worksheet, wsOut As Worksheet
Dim rwToWrite As Long, outWsName As String
Dim isFirstSh As Boolean, temp
If Target.Address(0, 0) <> "F1" Then
Exit Sub
ElseIf Target.Value = "" Then
Exit Sub
ElseIf Not Sh.Name Like "*依頼表*" Then
Exit Sub
ElseIf MsgBox("発注伝票を作成しますか？", vbYesNo) = vbYes Then
Cancel = True
isFirstSh = True
rwToWrite = 4 * 2
outWsName = Target.Value & "発注伝票" '出力シート名
For Each ws In Worksheets
If ws.Range("F1").Value = Target.Value Then
If Evaluate("ISREF(" & outWsName & "!A1)") Then '既存
Set wsOut = Worksheets(outWsName)
If isFirstSh = True Then
temp = wsOut.Range("A3").Value
wsOut.UsedRange.Offset(4).ClearContents '初回のみクリア
wsOut.Range("A3").Value = temp
End If
Else
Set wsOut = Worksheets.Add
wsOut.Name = outWsName
wsOut.Range("C2").Value = Target.Value & "発注伝票"
wsOut.Range("A4:H4").Value = [{"品名","コード番号","数量","単位","品名","コード番号","数量","単位"}]
End If
isFirstSh = False
wsOut.Range("A1").Value = Date
wsOut.Range("A1").NumberFormatLocal = "YYYY年M月D日"
Call shiftDATA(ws, wsOut, rwToWrite)
End If
Next
wsOut.Select
End If
End Sub
Private Sub shiftDATA(ws As Worksheet, wsOut As Worksheet, RtoWrite)
Dim cel As Range
Dim col As Long, lastRW As Long, i As Long
Dim v
Dim r As Long, c As Long
Dim 品名, 商品, 単位
With ws
lastRW = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For i = 6 To lastRW Step 4
品名 = ws.Range("A1").Offset(i - 3).Value
商品 = ws.Range("B1").Offset(i - 2).Value
単位 = ws.Range("C1").Offset(i - 2).Value
v = ws.Range("D1:AT2").Offset(i - 1).Value
For col = UBound(v, 2) To 1 Step -1
If IsNumeric(v(1, col)) Then
If v(1, col) > 0 And IsDate(v(2, col)) Then
RtoWrite = RtoWrite + 1
r = Int((RtoWrite + 1) / 2)
c = IIf(RtoWrite Mod 2 = 1, 1, 5)
wsOut.Cells(r, c + 1).NumberFormatLocal = "@"
wsOut.Cells(r, c).Resize(1, 4).Value = Array(品名, 商品, v(1, col), 単位)
Exit For
End If
End If
Next col
Next i
End With
End Sub
＞出来れば、発注で転記した場合は、発注済みだと分かるようにセルに色が付けば依頼表が見やすくなります。
申し訳ないですが、現在の構想は早晩破綻すると危惧していますので、 私の関与はここまでとさせていただきます。
他の回答者のレスをお待ちください。m(__)m
（半平太） 2020/08/22(土) 11:58
ありがとうございます。
早速、Thisworkbookモジュールに貼り付けて、発注依頼表のF1セルに業者名を設置し
右クリックしましたが、msgが出ません。何にも変化なしです。
出るのは、いつもの右クリックした時の画面です。
私のやり方が悪いのか？原因はなんでしょうか？
（カズ） 2020/08/23(日) 08:14
おはようございます ＾＾ 出ましたよ。。。＾＾； 。。。 シート名 依頼表 を含んでいますぅ？(￣▽￣) でわでわ。。。m(_ _)m （隠居じーさん） 2020/08/23(日) 08:47
ご教授ありがとうございます。
再度やってみます。
（カズ） 2020/08/23(日) 09:30
お世話になっています。
すみません。sheet名に「依頼表」が入っていませんでした。
ちゃんと出ました。
（カズ） 2020/08/23(日) 09:34
色々と、ご教授ありがとうございました。
動作確認をしました。
大丈夫です。
ちゃんと転記され、作業も早くなります。
本当に大感謝です。
（カズ） 2020/08/23(日) 10:15
色々とお世話になっています。
たびたびすみません。また問題点が出まして。
○が重複した場合、何日分重複しているか分かるようにしたいのですが、同じセルで重なった時
はカウントしてくれるでしょうか？
業者の定休日や、祝日で発注日が何日分か重なる場合、重なった日数が見てわかるようにしたいです。
例
AF AG AH AI AJ AK AL AM AN
2 9/17 9/18 9/19 9/20 9/21 9/22 9/23 9/24 9/25 3 木 金 土 日 月 火 水 木 金
4 10 10 10 10 10 10 10 5 ○ ○ 6 10 60
上記のように9/19に食材を使用する際の発注期限は9/17で17日に○。これはOK。
問題は、9/20〜9/24の間の食材は連休に入る為、まとめて9/19に発注をかけるので発注期限は9/18
となります。9/18の○は一つしかないので、ここの○は何日分まとめた○なのか？を分かるように
は出来ませんか？
例えば、重複1つは▲とか2つは◎、3つは×とかで記号で判別してもよいのですが。 何か見て分かる方法をご教授お願いします。
（カズ） 2020/08/24(月) 13:58
１．D5セル以降の条件付き書式を以下の通り変更する
＞旧条件式(参考まで) ＞=D7*1>0 → [赤]○
新条件式(改訂後)
=(MOD(D7,1)/0.5^8)=1 → [赤]○
=(MOD(D7,1)/0.5^8)=2 → [赤]◎2
=(MOD(D7,1)/0.5^8)=3 → [赤]◎3
=(MOD(D7,1)/0.5^8)=4 → [赤]◎4
： ：
以下、必要なだけ設定する。
２．数式を変更する
＞旧D7セル (参考まで) ＞=IF(COUNTIF($D5:$AT5,D$2),WORKDAY.INTL(D$2,$B7+1,$BD$1,$BC$3:$BC$55),"")
D7セル(改訂後) =IF(COUNTIF($D5:$AT5,D$2),WORKDAY.INTL(D$2,$B7+1,$BD$1,$BC$3:$BC$55)+COUNTIF($D5:$AT5,D$2)*0.5^8,"")
（半平太） 2020/08/24(月) 16:34
無駄が多かったので、変更します。m(__)m
１．D5セル以降の条件付き書式を以下の通り変更する
新条件式
=COUNTIF($D5:$AT5,D$2)=1 → [赤]○
=COUNTIF($D5:$AT5,D$2)=2 → [赤]◎2
=COUNTIF($D5:$AT5,D$2)=3 → [赤]◎3
： ：
以下、必要なだけ設定する。
２．数式は元に戻してください
D7=IF(COUNTIF($D5:$AT5,D$2),WORKDAY.INTL(D$2,$B7+1,$BD$1,$BC$3:$BC$55),"")
（半平太） 2020/08/24(月) 21:39
お世話になります。
度重なる変更、本当にありがとうございました。
今回の重複回数も、解決出来ました。
（カズ） 2020/08/25(火) 16:47
これが少し変更した現在のコードです。Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim ws As Worksheet, wsOut As Worksheet
Dim rwToWrite As Long, outWsName As String
Dim isFirstSh As Boolean, temp
If Target.Address(0, 0) <> "V1" Then
Exit Sub
ElseIf Target.Value = "" Then
Exit Sub
ElseIf Not Sh.Name Like "*依頼表*" Then
Exit Sub
ElseIf MsgBox("発注伝票を作成しますか？", vbYesNo) = vbYes Then
Cancel = True
isFirstSh = True
rwToWrite = 4 * 2
outWsName = Target.Value & "発注伝票" '出力シート名
For Each ws In Worksheets
If ws.Range("V1").Value = Target.Value Then
If Evaluate("ISREF(" & outWsName & "!A1)") Then '既存
Set wsOut = Worksheets(outWsName)
If isFirstSh = True Then
temp = wsOut.Range("A3").Value
wsOut.UsedRange.Offset(4).ClearContents '初回のみクリア
wsOut.Range("A3").Value = temp
End If
Else
Set wsOut = Worksheets.Add
wsOut.Name = outWsName
wsOut.Range("C2").Value = Target.Value & "発注伝票"
wsOut.Range("A4:J4").Value = [{"品名","コード番号","数量","単位","納品日","品名","コード番号","数量","単位","納品日"}]
End If
isFirstSh = False
wsOut.Range("A1").Value = Date
wsOut.Range("A1").NumberFormatLocal = "YYYY年M月D日"
Call shiftDATA(ws, wsOut, rwToWrite)
End If
Next
wsOut.Select
Range("A4:J24").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
Columns("A:J").EntireColumn.AutoFit
End With
End If
End Sub
Private Sub shiftDATA(ws As Worksheet, wsOut As Worksheet, RtoWrite)
Dim cel As Range
Dim col As Long, lastRW As Long, i As Long
Dim v
Dim r As Long, c As Long
Dim 品名, 商品, 単位
With ws
lastRW = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For i = 6 To lastRW Step 4
品名 = ws.Range("A1").Offset(i - 3).Value
商品 = ws.Range("A1").Offset(i - 2).Value
単位 = ws.Range("C1").Offset(i - 2).Value
v = ws.Range("D1:AT2").Offset(i - 1).Value
For col = UBound(v, 2) To 1 Step -1
If IsNumeric(v(1, col)) Then
If v(1, col) > 0 And IsDate(v(2, col)) Then
RtoWrite = RtoWrite + 1
r = Int((RtoWrite + 1) / 2)
c = IIf(RtoWrite Mod 2 = 1, 1, 6)
wsOut.Cells(r, c + 2).NumberFormatLocal = "@"
wsOut.Cells(r, c).Resize(1, 5).Value = Array(品名, 商品, v(1, col), 単位)
Exit For
End If
End If
Next col
Next i
End With
End Sub
これが現在の転記した時の発注伝票で、エラーになる部分です。
A B C D E F G H I J
4 品名 コード番号 数量 単位 納品日 品名 コード番号 数量 単位 納品日
5 ○○ 467898 25 Kg #N/A ○○ 123456 10 RL #N/A
となります。発注依頼表の発注数の直ぐ下の納品日がm/dで発注伝票に表示したいのです。
すみません。色々と試しているうちに、あれもこれもと実施したい事が増えてしまい。
宜しくお願いします。
（カズ） 2020/08/27(木) 08:55
＞ ・在庫があり注文しない場合は発注数の代わりに「-」を入れています。
ついでに「-」(注文伝票に載せない）が、未対応だったので、一緒に修正します。
＞ For col = UBound(v, 2) To 1 Step -1 ＞ If IsNumeric(v(1, col)) Then ＞ If v(1, col) > 0 And IsDate(v(2, col)) Then ＞ RtoWrite = RtoWrite + 1 ＞ r = Int((RtoWrite + 1) / 2) ＞ c = IIf(RtoWrite Mod 2 = 1, 1, 6) ＞ wsOut.Cells(r, c + 2).NumberFormatLocal = "@" ＞ wsOut.Cells(r, c).Resize(1, 5).Value = Array(品名, 商品, v(1, col), 単位) ＞ Exit For ＞ End If ＞ End If ＞ Next col
↓
For col = UBound(v, 2) To 1 Step -1
If v(1, col) = "-" Then
Exit For
ElseIf IsNumeric(v(1, col)) Then
If v(1, col) > 0 And IsDate(v(2, col)) Then
RtoWrite = RtoWrite + 1
r = Int((RtoWrite + 1) / 2)
c = IIf(RtoWrite Mod 2 = 1, 1, 6)
wsOut.Cells(r, c + 2).NumberFormatLocal = "@"
wsOut.Cells(r, c).Resize(1, 5).Value = Array(品名, 商品, v(1, col), 単位, v(2, col))
Exit For
End If
End If
Next col
（半平太） 2020/08/27(木) 11:14
お世話になります。
修正ありがとうございました。
今回も、完璧に表示されました。
（カズ） 2020/08/28(金) 08:51
お世話になっています。
何度もすみません。
またお聞きしたい事ができたので、教えて下さい。
発注依頼表のデーターを発注伝票に転記する際ですが、発注伝票を既に作成しているのに操作を誤って同じ伝票を作る操作をした場合、依頼表の表がおかしくなってしまいます。
と言うのは、発注依頼表の方に作成された伝票が転記されます。
発注伝票を作成し直したい時は、出来た伝票を削除すれば問題は無いのですが、2重操作をしてしまった場合に、何かメッセージを出して回避するか？そのまま上書きされるか？
したいのですが可能でしょうか？
（カズ） 2020/09/01(火) 16:44
＞発注伝票を既に作成しているのに操作を誤って同じ伝票を作る操作をした場合、 ＞依頼表の表がおかしくなってしまいます。
同じ伝票を作る操作をしても、同じ伝票ができるだけだと思いますけども。
※途中、そちらで何かコード変更をしたと思うんですが、そのセイと言うことはないですか？ それが原因なら私は分からないです。
（半平太） 2020/09/01(火) 16:51
＞ For Each ws In Worksheets
＞ If ws.Range("F1").Value = Target.Value Then
もしかすると、以下の修正すれば解決するかも知れません
For Each ws In Worksheets
If ws.Range("F1").Value = Target.Value And Sh.Name Like "*依頼表*" Then
~~~~~~~~~~↑~~~~~~~~~~~~~~~
条件を追加
（半平太） 2020/09/01(火) 17:15
お世話になっています。
すみません。色々と。
※途中、そちらで何かコード変更をしたと思うんですが、そのセイと言うことはないですか？
ご教授ありがとうございます。その通りでした。私が少し付け加えた部分が間違っていました。 今、修正して、解決しました。 お騒がせして申し訳ありません。 （カズ） 2020/09/02(水) 10:22
以前よりお世話になっております。
すみません。また少し変更をしたいです。
依頼表から発注伝票の作成の所で、伝票作成に当たり、入力必須項目が発注数も入って
いるので、発注数が空欄でも伝票が作成されるように変更したいです。
と言うのも、現在の発注の流れとしては発注依頼表に○を付けたあと、各業者の依頼表を印刷して実際の在庫数を確認して、必要により発注と言う流れです。
依頼表には、依頼予定の○が付いた商品や、依頼しない商品も同じ表の為、少し見にくいので現場で在庫確認し易いように発注数を入れる前の伝票を作成し、その伝票で在庫確認が出来ればと思います。
在庫確認後は、発注は必要な商品は数を入れて、伝票を作成します。
幾度の、修正発生で、まことに恐縮ですが、どうかお願いします。
（カズ） 2020/09/25(金) 10:07
＞発注数が空欄でも伝票が作成されるように変更したいです。
空欄とは、どこのセルが空欄なんですか？（１つのセルの例で結構です）
（半平太） 2020/09/25(金) 12:25
お世話になっています。
行 ____A____ _B_ _C_ __D__ _ E _ ___ F ___ __G__ __H__ _ I _ _ J _ __K__ __ L __ __M__ _N_ O P Q _R_ _S_ _T_ ______BC______ ___BD___ ____BE____
1 ××業者 0001011
2 2/20 2/21 2/22 2/23 2/24 2/25 2/26 2/27 2/28 2/29 3/1 3/2 3/3 3/4 3/5 3/6 3/7 祝日一覧 業者名 休パターン
3 木 金 土 日 月 火 水 木 金 土 日 月 火 水 木 金 土 2020/1/1(水) 〇〇業者 0000000
4 豚レバー 50 2020/1/13(月) ××業者 0001011
5 商品No Kg ○ 2020/2/11(火) △△業者 0101011
6 在庫管理 40 2020/2/23(日)
7 中3日 3 3/6 2020/2/24(月)
8 牛バラ 60 2020/3/20(金)
9 商品No Kg ○ 2020/4/29(水)
10 在庫管理 30 2020/5/3(日)
11 中2日 2 3/4 2020/5/4(月)
2020/5/5(火)
上記の表ですと、〇の下の6行、10行の在庫管理の部分になります。豚レバーが40、牛バラが30とありますが、この数字は実際に現物で在庫を確認したあとに在庫がなければ数字を入れ40発注とかになります。
なので、在庫確認は、まだ数字を入れないで空欄のまま表を印刷して現物確認をする為、一旦〇が付いた商品を仮の伝票等にピックアップしたいです。
宜しくお願いします。
（カズ） 2020/09/25(金) 17:06
Private Sub shiftDATA(ws As Worksheet, wsOut As Worksheet, RtoWrite)
Dim cel As Range
Dim col As Long, lastRW As Long, i As Long
Dim v
Dim r As Long, c As Long
Dim 品名, 商品, 単位
With ws
lastRW = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For i = 6 To lastRW Step 4
品名 = ws.Range("A1").Offset(i - 3).Value
商品 = ws.Range("B1").Offset(i - 2).Value
単位 = ws.Range("C1").Offset(i - 2).Value
v = ws.Range("D1:AT2").Offset(i - 1).Value
For col = UBound(v, 2) To 1 Step -1
If IsDate(v(2, col)) Then
RtoWrite = RtoWrite + 1
r = Int((RtoWrite + 1) / 2)
c = IIf(RtoWrite Mod 2 = 1, 1, 6)
wsOut.Cells(r, c + 2).NumberFormatLocal = "@"
wsOut.Cells(r, c).Resize(1, 5).Value = Array(品名, 商品, v(1, col), 単位, v(2, col))
Exit For
End If
Next col
Next i
End With
End Sub
（半平太） 2020/09/25(金) 17:55
お世話になります。
早々に改修して頂き、有難うございました。
思い通りに表示されます。
これで、全業者分ピックアップし、ひとつに纏めるので紙も少なくなり
在庫確認も楽になります。
ありがとうございました。
（カズ） 2020/09/25(金) 21:17
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.