六星占術
私も一応?プログラマーのハシクレ?なので昨日テレビを見ててなんとなく作ってみました。金星人とか土星人とか言うやつです。今日会社から帰ってから今までかかった…データを入れるのが面倒だった~キリトリの内側をウィンドウズのメモ帳などに貼り付けvbsという拡張子を付けて保存して下さい。例えば、star.vbsとか…この拡張子が付いてないと動きません。エクスプローラで見てファイルの種類がVBScript Script FileとなっていればOKです。後、エクスプローラでダブルクリックすれば動きます。根性が尽きたので昭和50年までしか入れてないのですが誰か続きを入れてくれるとうれしいそれに目視で入れてるので間違ってるかも?間違いは指摘してくれるとうれしいです。この程度で何か言われるとは思えないのですが出版社関連とかに強く言われたら削除するかも?そんなことはないと思うけど…どちらかというとこういうのがあると売上は伸びると思うのだが…結局、肝心の内容は本を買わないと見れないのだから…プラスとかマイナスの表示もないし霊合星も無いので気が向いたら追加するかも?もしこのプログラムを使用して何かあっても責任は取れません。スクリプトプログラムなのでプログラム自体が見れるので問題が無いのはわかると思いますが…---------- キリトリ ---------- ' ******************************* ' *** 運命星の算出 *** ' *** Create : July 13, 2005 *** ' *** Author : きぃたん@大阪 *** ' ******************************* Dim nReply Dim strInput Dim UnSuu Dim UnmeiSuu ' *** 大正1年から昭和50年までのデータ *** UnSuu = Array(13, 44, 13, 44, 14, 45, 15, 46, 17, 47, 18, 48, _ 19, 50, 18, 49, 19, 50, 20, 51, 22, 52, 23, 53, _ 24, 55, 23, 54, 24, 55, 25, 56, 27, 57, 28, 58, _ 29, 60, 28, 59, 29, 60, 30, 61, 32, 2, 33, 3, _ 34, 5, 34, 5, 35, 6, 36, 7, 38, 8, 39, 9, _ 40, 11, 39, 10, 40, 11, 41, 12, 43, 13, 44, 14, _ 45, 16, 44, 15, 45, 16, 46, 17, 48, 18, 49, 19, _ 50, 21, 49, 20, 50, 21, 51, 22, 53, 23, 54, 24, _ 55, 26, 55, 26, 56, 27, 57, 28, 59, 29, 60, 30, _ 61, 32, 60, 31, 61, 32, 2, 33, 4, 34, 5, 35, _ 6, 37, 5, 36, 6, 37, 7, 38, 9, 39, 10, 40, _ 11, 42, 10, 41, 11, 42, 12, 43, 14, 44, 15, 45, _ 16, 47, 16, 47, 17, 48, 18, 49, 20, 50, 21, 51, _ 22, 53, 21, 52, 22, 53, 23, 54, 25, 55, 26, 56, _ 27, 58, 26, 57, 27, 58, 28, 59, 30, 60, 31, 61, _ 32, 3, 31, 2, 32, 3, 33, 4, 35, 5, 36, 6, _ 37, 8, 37, 8, 38, 9, 39, 10, 41, 11, 42, 12, _ 43, 14, 42, 13, 43, 14, 44, 15, 46, 16, 47, 17, _ 48, 19, 47, 18, 48, 19, 49, 20, 51, 21, 52, 22, _ 53, 24, 52, 23, 53, 24, 54, 25, 56, 26, 57, 27, _ 58, 29, 58, 29, 59, 30, 60, 31, 2, 32, 3, 33, _ 4, 35, 3, 34, 4, 35, 5, 36, 7, 37, 8, 38, _ 9, 40, 8, 39, 9, 40, 10, 41, 12, 42, 13, 43, _ 14, 45, 13, 44, 14, 45, 15, 46, 17, 47, 18, 48, _ 19, 50, 19, 50, 20, 51, 21, 52, 23, 53, 24, 54, _ 25, 56, 24, 55, 25, 56, 26, 57, 28, 58, 29, 59, _ 30, 61, 29, 60, 30, 61, 31, 2, 33, 3, 34, 4, _ 35, 6, 34, 5, 35, 6, 36, 7, 38, 8, 39, 9, _ 40, 11, 40, 11, 41, 12, 42, 13, 44, 14, 45, 15, _ 46, 17, 45, 16, 46, 17, 47, 18, 49, 19, 50, 20, _ 51, 22, 50, 21, 51, 22, 52, 23, 54, 24, 55, 25, _ 56, 27, 55, 26, 56, 27, 57, 28, 59, 29, 60, 30, _ 61, 32, 61, 32, 2, 33, 3, 34, 5, 35, 6, 36, _ 7, 38, 6, 37, 7, 38, 8, 39, 10, 40, 11, 41, _ 12, 43, 11, 42, 12, 43, 13, 44, 15, 45, 16, 46, _ 17, 48, 16, 47, 17, 48, 18, 49, 20, 50, 21, 51, _ 22, 53, 22, 53, 23, 54, 24, 55, 26, 56, 27, 57, _ 28, 59, 27, 58, 28, 59, 29, 60, 31, 61, 32, 2, _ 33, 4, 32, 3, 33, 4, 34, 5, 36, 6, 37, 7, _ 38, 9, 37, 8, 38, 9, 39, 10, 41, 11, 42, 12, _ 43, 14, 43, 14, 44, 15, 45, 16, 47, 17, 48, 18, _ 49, 20, 48, 19, 49, 20, 50, 21, 52, 22, 53, 23, _ 54, 25, 53, 24, 54, 25, 55, 26, 57, 27, 58, 28, _ 59, 30, 58, 29, 59, 30, 60, 31, 2, 32, 3, 33, _ 4, 35, 4, 35, 5, 36, 6, 37, 8, 38, 9, 39, _ 10, 41, 9, 40, 10, 41, 11, 42, 13, 43, 14, 44, _ 15, 46, 14, 45, 15, 46, 16, 47, 18, 48, 19, 49, _ 20, 51, 19, 50, 20, 51, 21, 52, 23, 53, 24, 54, _ 25, 56, 25, 56, 26, 57, 27, 58, 29, 59, 30, 60, _ 31, 2, 30, 61, 31, 2, 32, 3, 34, 4, 35, 5, _ 36, 7, 35, 6, 36, 7, 37, 8, 39, 9, 40, 10, _ 41, 12, 40, 11, 41, 12, 42, 13, 44, 14, 45, 15, _ 46, 17, 46, 17, 47, 18, 48, 19, 50, 20, 51, 21, _ 52, 23, 51, 22, 52, 23, 53, 24, 55, 25, 56, 26, _ 57, 28, 56, 27, 57, 28, 58, 29, 60, 30, 61, 31, _ 2, 33, 61, 32, 2, 33, 3, 34, 5, 35, 6, 36, _ 7, 38, 7, 38, 8, 39, 9, 40, 11, 41, 12, 42, _ 13, 44, 12, 43, 13, 44, 14, 45, 16, 46, 17, 47, _ 18, 49, 17, 48, 18, 49, 19, 50, 21, 51, 22, 52, _ 23, 54, 22, 53, 23, 54, 24, 55, 26, 56, 27, 57, _ 28, 59, 28, 59, 29, 60, 30, 61, 32, 2, 33, 3, _ 34, 5, 33, 4, 34, 5, 35, 6, 37, 7, 38, 8, _ 39, 10, 38, 9, 39, 10, 40, 11, 42, 12, 43, 13, _ 44, 15, 43, 14, 44, 15, 45, 16, 47, 17, 48, 18) ' *** 生年月日の入力 *** strInput = InputBox("生年月日を西暦で入力して下さい。" & vbLf & _ "入力範囲は1912年から1975年までです。" & vblf & _ "入力例: 1999/09/09", _ "運命星を計算します。", Date()) ' *** キャンセルをクリックすると終了 *** If strInput "" then UnmeiSuu = UnSuu(((Year(strInput) - 1912) * 12) + Month(strInput) - 1) - 1 + Day(strInput) ' *** 運命数が61以上の時は60を引く *** If UnmeiSuu >= 61 then UnmeiSuu = UnmeiSuu - 60 End if ' *** 星数から運命星を知る *** If 1