« 2007年5 月 | メイン | 2007年7 月 »
2007年6 月 からの記事
2007年6 月26日 (火曜日)
2007年6 月24日 (日曜日)
2007年6 月23日 (土曜日)
2007年6 月22日 (金曜日)
2007年6 月21日 (木曜日)
三四郎マクロでゲーム作成第三弾・・・Speed
名称：スピード
*
*
*
*
*
*
*
ゲームの目的：同じ牌をクリックするとその牌が裏向きになります。
なるべく短時間で全ての牌を裏返してください。
全部裏返すと所要時間が表示されます。
ゲームの開始：「START」をクリックする。
※ゲームを中止するときには「中止」を２回クリックしてください。
ダウンロード：SPEED.lzhをダウンロード
スピードのコード：
Call Init()
MsgBox("ゲームを始めます")
%BlankCell=0
%StartTime = ThisTime()
Do While %BlankCell <108
Set %FirstCell = Range?
Set %SecondCell = Range?
If %FirstCell ="中止" Or %SecondCell ="中止"Then
MsgBox("ゲームを中止します。")
Stop
End If
%X1 = Col(%FirstCell)
%Y1 = Row(%FirstCell)
%X2 = Col(%SecondCell)
%Y2 = Row(%SecondCell)
If Cells(%Y1, %X1)=Cells(%Y2, %X2) Then
%FirstCell.Clear(1, false, false, false)
%SecondCell.Clear(1, false, false, false)
%FirstCell.CellStyle.BackColor = RGB(204, 153, 0)
%SecondCell.CellStyle.BackColor = RGB(204, 153, 0)
%BlankCell=%BlankCell+2
End If
Loop
%EndTime = ThisTime()
%ElapsedTime =%EndTime-%StartTime
%MyMsg=Minute(%ElapsedTime) & " 分" & Second(%ElapsedTime) & " 秒かかりました。"
MsgBox(%MyMsg)
Sub Init()
declare variable Pai(108) As String
declare variable Temp As String
declare variable Moji As String
declare variable X as Integer
declare variable Y as Integer
declare variable i as Integer
Pai()={"一索","二索","三索","四索","五索","六索","七索","八索","九索",\\
"一索","二索","三索","四索","五索","六索","七索","八索","九索", \\
"一索","二索","三索","四索","五索","六索","七索","八索","九索",\\
"一索","二索","三索","四索","五索","六索","七索","八索","九索",\\
"一筒","二筒","三筒","四筒","五筒","六筒","七筒","八筒","九筒",\\
"一筒","二筒","三筒","四筒","五筒","六筒","七筒","八筒","九筒",\\
"一筒","二筒","三筒","四筒","五筒","六筒","七筒","八筒","九筒",\\
"一筒","二筒","三筒","四筒","五筒","六筒","七筒","八筒","九筒",\\
"一萬","二萬","三萬","四萬","五萬","六萬","七萬","八萬","九萬",\\
"一萬","二萬","三萬","四萬","五萬","六萬","七萬","八萬","九萬",\\
"一萬","二萬","三萬","四萬","五萬","六萬","七萬","八萬","九萬",\\
"一萬","二萬","三萬","四萬","五萬","六萬","七萬","八萬","九萬"}
Range("D6:O14").Clear(1, false, false, false)
Range("D6:O14").CellStyle.BackColor = RGB(204, 153, 0)
MsgBox("ゲームを始めます")
!!シャッフル
Randomize(ThisTime())
For i = 1 TO 1000
X = Int(Rand() * 108)+1
Y = Int(Rand() * 108)+1
Temp=Pai(x)
Pai(x) =Pai(y)
Pai(y)=Temp
Next
i=1
For y = 6 To 14
For x = 4 To 15
Cells(y, x) = Pai(i)
Moji = Right(Pai(i),1)
select case Moji
Case "萬"
Cells(y, x).CellStyle.BackColor = RGB(204, 255, 255)
Case "筒"
Cells(y, x).CellStyle.BackColor = RGB(255, 204, 204)
Case "索"
Cells(y, x).CellStyle.BackColor = RGB(204, 255, 153)
End Select
i = i +1
Next
Next
End Sub
2007年6 月18日 (月曜日)
簡易カレンダー作成マクロ
| このサイトは「教員のための三四郎活用術」なのですがこの頃、とんと三四郎が話題に上ってきません。すっかり、三四郎から遠ざかってしまっています。 さて一太郎Q&A掲示板を何気なく見たら、何やらくまぷーにも答えられそうな質問がありました。ここの掲示板には以前一度、回答をしました。一太郎に関する質問に回答するのは初めてだったので、ドキドキだったのですが質問者にほったらかしにされてしまい悲しかったのですが、マナーの悪い人ばかりではなかろうとついまた回答をしてしまいました。すると今度はすぐにレスが付いたのでニコニコです。 | ||||||
名称：簡易カレンダー作成マクロ
* * * * *
|
2007年6 月17日 (日曜日)
一太郎の表計算機能
今回のお題は「一太郎の表計算機能」だ。
ご存じの通り、一太郎には「罫線」-「計算」-｢計算」から
呼び出す簡易計算機能がある。
これは簡単な四則演算しかすることができないが、
今回のテーマ、日経表計算大会マクロ部門の問題では
足し算と引き算しか使わないので、
この機能で十分対応できる・・・と思っていた。
ところが、少し考えが甘かったようだ。
*
*
*
*
*
上図を見て欲しい。 D=A+B-C という計算が出来ないのだ。
A,B,C,Dが同列または同行に存在しないとエラーになるようである。
この辺りは作業セルを使えば何とかなるであろうが、
機能的に少々貧しい。
表のレイアウトをオリジナルのままにしておきたかったので
この機能を使うのはやめることにした。
一太郎にはこの他にもう一つ作表機能がある。
「挿入」-「表枠」から呼び出すやつだ。
しかし、これは一太郎内の機能ではない。
別のソフトで作った表を貼り付けるだけである。
いわば三四郎やExcelで作った表を
リンク貼り付けするのと同じだから問題外である。
この部分もマクロでやらざるを得ないようだな。
一太郎はラクをさせてはくれない。
ほんとうに一太郎は楽しいな。
2007年6 月16日 (土曜日)
2007年6 月15日 (金曜日)
2007年6 月13日 (水曜日)
2007年6 月12日 (火曜日)
2007年6 月11日 (月曜日)
2007年6 月10日 (日曜日)
2007年6 月 9日 (土曜日)
2007年6 月 8日 (金曜日)
2007年6 月 7日 (木曜日)
2007年6 月 6日 (水曜日)
一太郎･･･漢字書取問題作成マクロⅢ公開
いよいよ漢字書取問題作成マクロⅢの公開です。ここでもう一度、
漢字書取問題作成マクロの流れを整理してみます。
悪児さんのバージョン（漢字書取問題作成マクロ・初代）はマクロ実行前に
『「ふりがな」－「すべての単語」を実行してから、マクロを実行』しなければなりません。
これは一太郎の標準コマンド「すべての単語」がマクロに対応していないというところから
来る制限でした。
そこで、くまぷーは漢字書取問題作成マクロⅡを作りました。
漢字書取問題作成マクロⅡは一太郎からExcelを呼び出し、その機能を
使い悪児さんバージョンの制限を回避するというものでした。
しかし、漢字書取問題作成マクロⅡはExcelの機能を使うが故に
Excelのインストールされていない環境では使えないという制限がありました。
漢字書取問題作成マクロⅢは悪児さんバージョンの制限と
漢字書取問題作成マクロⅡの制限をともに克服したものです。
Excel無しの環境で、かつマクロ実行前に『「ふりがな」－「すべての単語」を
実行することなく、漢字書取問題を作成することができます。
以下がその実行法です。 手順１：出題する漢字を全角の括弧で囲む。
* * 手順２：マクロ処理したい範囲を選択する。
* * 手順３：マクロ「漢字書取問題作成Ⅲ」を実行する。すると下のように出力される。
* * メモ１：ふりがなを自動で取得できない場合、またはふりがなが正しくない場合は 確認のダイアログから正しいふりがなを入力する。 | |
2007年6 月 5日 (火曜日)
2007年6 月 4日 (月曜日)
2007年6 月 3日 (日曜日)
一太郎マクロ・・・PushKeys()の怪(3)
一太郎マクロのPushKeys（）の動作にはどうも妙なクセがあるようだ。
そこでくまぷーはヘルプを見てみた。そこには「PushKeys関数は入力待ちに
なってはじめて呼び出されます。」とある。そこでくまぷーは以下のコードを
使って検証してみることにした。
For %i = 1 to 5
PushKeys("1{ENTER}2{ENTER}")
Next
Wait(3)
Insert("BEBE",1)
Wait()はマクロの実行を停止し、指定した時間後に再開しするという命令だ。
こうすればPushKeys（）を実行した後に3秒おいてInsert（）が実行されるのでは
ないかと期待したが、結果は下図のとおりで、結局はPushKeys（）よりも
Insert（）が先に実行されてしまった。
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
そこで次に試したのがtry文を利用した例外処理だ。
try
gonnyo
exception
Hoge
end try
tryとexceptionの間に記述したコードgonnyoでエラーが起きると
exception以下のHogeが実行される。この条件分岐を使えば
ひょっとしたら何とかなるかも知れないと根拠はないのだが足掻いてみた。
try
For %i = 1 to 5
PushKeys("1{ENTER}2{ENTER}")
Next
%x=0
%x=9/%x !!ゼロ除算
exception
case "searcherror"
case else
Insert("BEBE",1)
end try
しかし、結果は先程と同じでPushKeys（）よりもInsert（）が先に
実行されてしまった。とほほ・・・。(-_-;)
一太郎マクロ・・・PushKeys()の怪(2)
一太郎マクロのPushKeys（）の動作にはどうも妙なクセがあるようだ。
そこでくまぷーはヘルプを見てみた。そこには「PushKeys関数は入力待ちに
なってはじめて呼び出されます。」とある。
そこでくまぷーは以下のコードを使って検証してみることにした。
For %i = 1 to 5
PushKeys("1{ENTER}2{ENTER}")
Next
Insert("BEBE",1)
コードが上から下に逐次実行されるのならば実行結果は
下の通りになるはずである。
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
ところが実際にはそうはならず、下のような結果になってしまう・・・。
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
*
Insert("BEBE",1) ・・・・・の方が
For %i = 1 to 5
PushKeys("1{ENTER}2{ENTER}")
Next
・・・・・よりも先に実行されてしまうのだ！！
（●｀ε´●）：
|
ヘルプに「PushKeys関数は入力待ちになってはじめて呼び出されま す。」とあるのはこういうことか・・・。 |
2007年6 月 2日 (土曜日)
2007年6 月 1日 (金曜日)
一太郎マクロ・・・WORD FIND公開
いよいよ、WORD FIND完成版の公開だ。実はいよいよ、と言っているが
とうの昔に出来上がっていたのだ。だから、今コードを見直してみると
気持ちの悪い部分もあるのだが、一太郎マクロ処女作ということで
敢えて手直しせずに公開することにした。下がそのキャプチャー画面である。
*
*
*
*
*
*
*
*
*
*
*
| 免責： | このマクロの使用によっていかなる損害が生じようと、一切責任は負いません。あらかじめご承知の上ご使用下さい。 |
| マクロ名： | 「WORD FIND」 |
| 機能： | リストに入力した単語を１２×１２のマス目にランダムに配置する。 |
| 詳細： | 単語は２０個まで。 |
| 単語配置は右から左、左から右、上から下、下から上、右下から左上、左上から右下、左下から右上、右上から左下の８方向にランダムに配置する。 | |
| ブランクのマスにはオプションでランダムにアルファベットを配置する。 | |
| 実行法： | 右上の「★実 行★」ボタンをクリックする。 |
以下がそのコードだ。
declare variable $MyCell(1 To 12, 1 To 12)
%TopWall = 1
%BottomWall = 12
%LeftWall = 1
%RightWall = 12
%LoopCountMax=100
!!単語の長さを取得する
SetLength
!!単語を長い順にソートする
For %i = 1 to 20-1
For %j = %i + 1 To 20
If $Length(%i) < $Length(%j) Then
%Temp =$MyWord(%i)
$MyWord(%i) = $MyWord(%j)
$MyWord(%j) = %Temp
%TempNum =$Length(%i)
$Length(%i) = $Length(%j)
$Length(%j) = %TempNum
End If
Next
Next
!!単語、既データ消去
ｼﾞｬﾝﾌﾟ(.ﾍﾟｰｼﾞ番号=1,.行番号=5,.文字位置=44)
For %i = 1 To 20
削除(.回数=12)
Insert($MyWord(%i))
DownCell
Next
!!単語の長さ、既データ消去
ｼﾞｬﾝﾌﾟ(.ﾍﾟｰｼﾞ番号=1,.行番号=5,.文字位置=69)
For %i= 1 to 20
削除(.回数=2)
Insert($Length(%i))
DownCell()
Next
!!単語をメモリ上のセル%MyCellに書き込む
%LoopCount=1
Do
%WordNum = 1
For %i = 1 To 30000
If %WordNum = 20+1 Then !!20はwordの最大数
Exit Do
End if
!!%LoopCountMaxに達しても回答例が見つからないときの処理－－開始－－
If %LoopCount = %LoopCountMax Then
%para = {.Title = "回答例が見つかりません。", .Icon = 3, .Button = 5}
%Ans = MsgBox("処理を続けますか?", %para)
If %Ans = 6 Then !! 6は「はい」
%LoopCount = 0
Else
Stop
End If
End If
!!%LoopCountMaxに達しても回答例が見つからないときの処理－－終了－－
%Str = $MyWord(%WordNum)
Randomize(ThisTime())
%X = Int(Rand() * 12) + 1
%Y = Int(Rand() * 12) + 1
Randomize(ThisTime()) !!8方向
%Dir = Int(Rand() * 12)+1
%Length = Len(%Str)
%CanPlace = True
Select Case %Dir
Case 1 !!Bottom to Top
If %Y - %Length + 1 >= %TopWall Then
For %DY = %Length To 1 Step -1
If $MyCell(%Y - %DY + 1, %X) <> "" And $MyCell(%Y - %DY + 1, %X) <> Mid(%Str, %DY, 1) Then
%CanPlace = False
Exit For
End If
Next
If %CanPlace = True Then
For %DY = %Length To 1 Step -1
$MyCell(%Y - %DY + 1, %X) = Mid(%Str, %DY, 1)
Next
%WordNum = %WordNum + 1
End If
End If
Case 2 To 3 !!LeftBottom to RightTop
If %Y - %Length + 1 >= %TopWall Then
If %X + %Length - 1 <= %RightWall Then
For %DY = %Length To 1 Step -1
For %DX = 1 To %Length
If $MyCell(%Y - %DY + 1, %X + %DX - 1) <> "" And $MyCell(%Y - %DY + 1, %X + %DX - 1) <> Mid(%Str, %DY, 1) Then
%CanPlace = False
Exit For
End If
Next
Next
If %CanPlace = True Then
For %DY = %Length To 1 Step -1
$MyCell(%Y - %DY + 1, %X + %DY - 1) = Mid(%Str, %DY, 1)
Next
%WordNum = %WordNum + 1
End If
End If
End If
Case 4 !! Left to Right
If %X + %Length - 1 <= %RightWall Then
For %DX = 1 To %Length
If $MyCell(%Y, %X + %DX - 1) <> "" And $MyCell(%Y, %X + %DX - 1) <> Mid(%Str, %DX, 1) Then
%CanPlace = False
Exit For
End If
Next
If %CanPlace = True Then
For %DX = 1 To %Length
$MyCell(%Y, %X + %DX - 1) = Mid(%Str, %DX, 1)
Next
%WordNum = %WordNum + 1
End If
End If
Case 5 To 6 !!LeftTop to RightBottom
If %X + %Length - 1 <= %RightWall Then
If %Y + %Length - 1 <= %BottomWall Then
For %DX = 1 To %Length
For %DY = 1 To %Length
If $MyCell(%Y + %DY - 1, %X + %DX - 1) <> "" And $MyCell(%Y + %DY - 1, %X + %DX - 1) <> Mid(%Str, %DY, 1) Then
%CanPlace = False
Exit For
End If
Next
Next
If %CanPlace = True Then
For %DX = 1 To %Length
$MyCell(%Y + %DX - 1, %X + %DX - 1) = Mid(%Str, %DX, 1)
Next
%WordNum = %WordNum + 1
End If
End If
End If
Case 7 !! Top To Bottom
If %Y + %Length - 1 <= %BottomWall Then
For %DY = 1 To %Length
If $MyCell(%Y + %DY - 1, %X) <> "" And $MyCell(%Y + %DY - 1, %X) <> Mid(%Str, %DY, 1) Then
%CanPlace = False
Exit For
End If
Next
If %CanPlace = True Then
For %DY = 1 To %Length
$MyCell(%Y + %DY - 1, %X) = Mid(%Str, %DY, 1)
Next
%WordNum = %WordNum + 1
End If
End If
Case 8 To 9 !!RightTop to LeftBottom
If %X - %Length + 1 >= %LeftWall Then
If %Y + %Length - 1 <= %BottomWall Then
For %DX = %Length To 1 Step -1
For %DY = 1 To %Length
If $MyCell(%Y + %DY - 1, %X - %DX + 1) <> "" And $MyCell(%Y + %DY - 1, %X - %DX + 1) <> Mid(%Str, %DX, 1) Then
%CanPlace = False
Exit For
End If
Next
Next
If %CanPlace = True Then
For %DX = %Length To 1 Step -1
$MyCell(%Y + %DX - 1, %X - %DX + 1) = Mid(%Str, %DX, 1)
Next
%WordNum = %WordNum + 1
End If
End If
End If
Case 10 !! Right to Left
If %X - %Length + 1 >= %LeftWall Then
For %DX = %Length To 1 Step -1
If $MyCell(%Y, %X - %DX + 1) <> "" And $MyCell(%Y, %X - %DX + 1) <> Mid(%Str, %DX, 1) Then
%CanPlace = False
Exit For
End If
Next
If %CanPlace = True Then
For %DX = %Length To 1 Step -1
$MyCell(%Y, %X - %DX + 1) = Mid(%Str, %DX, 1)
Next
%WordNum = %WordNum + 1
End If
End If
Case 11 To 12 !! RightBottom to LeftTop
If %X - %Length + 1 >= %LeftWall Then
If %Y - %Length + 1 >= %TopWall Then
For %DX = %Length To 1 Step -1
For %DY = %Length To 1 Step -1
If $MyCell(%Y - %DY + 1, %X - %DX + 1) <> "" And $MyCell(%Y - %DY + 1, %X - %DX + 1) <> Mid(%Str, %DX, 1) Then
%CanPlace = False
Exit For
End If
Next
Next
If %CanPlace = True Then
For %DX = %Length To 1 Step -1
$MyCell(%Y - %DX + 1, %X - %DX + 1) = Mid(%Str, %DX, 1)
Next
%WordNum = %WordNum + 1
End If
End If
End If
End Select
Next
%LoopCount = %LoopCount + 1
Loop
%para = {.Title = "回答例が見つかりました。", .Icon = 3, .Button = 5}
%Ans = MsgBox("空白をアルファベットで埋めますか?", %para)
!!SlamIt
If %Ans=6 Then
FillBlank
End If
SlamIt
Sub SetLength
ｼﾞｬﾝﾌﾟ(.ﾍﾟｰｼﾞ番号=1,.行番号=5,.文字位置=44)
For %y = 1 to 20
%Str=""
For %x = 1 to 12
%S = GetCharacter()
If %S= " " Or %S = " " Then
Exit For
End If
右
%Str = %Str & %S
Next
$MyWord(%y)=%Str
$Length(%y) = Len(%Str)
ｼﾞｬﾝﾌﾟ(.ﾍﾟｰｼﾞ番号=1,.行番号=(5+%y),.文字位置=44)
Next
ｼﾞｬﾝﾌﾟ(.ﾍﾟｰｼﾞ番号=1,.行番号=5,.文字位置=68)
For %i= 1 to 20
削除(.回数=2)
Insert($Length(%i))
DownCell()
Next
End Sub
sub FillBlank
ｼﾞｬﾝﾌﾟ(.ﾍﾟｰｼﾞ番号=1,.行番号=4,.文字位置=2)
範囲選択開始(.単位=1)
範囲選択単位(.単位=7)
ｼﾞｬﾝﾌﾟ(.ﾍﾟｰｼﾞ番号=1,.行番号=15,.文字位置=73)
削除(.回数=1)
For %Y = 1 To 12
For %X = 1 To 12
Randomize(ThisTime())
%num = Int(Rand() * 26) + 97
If $MyCell(%Y, %X)="" then
$MyCell(%Y, %X)= Char(%num)
End If
Next
Next
end sub
sub SlamIt
ｼﾞｬﾝﾌﾟ(.ﾍﾟｰｼﾞ番号=1,.行番号=4,.文字位置=2)
範囲選択開始(.単位=1)
範囲選択単位(.単位=7)
ｼﾞｬﾝﾌﾟ(.ﾍﾟｰｼﾞ番号=1,.行番号=15,.文字位置=73)
削除(.回数=1)
For %Y = 1 To 12
For %X = 1 To 12
Randomize(ThisTime())
%num = $MyCell(%Y, %X)
Insert(%num)
if %X < 12 Then
RightCell()
End If
Next
DownCell
LeftCell(11)
Next
end sub
検索
カテゴリー
- Excel VBA for Teachers (15)
- Excelで４択 (11)
- Super Play Rite の基本 (7)
- VBS for Teachers (12)
- Word VBA for Teachers (20)
- お知らせ (50)
- くまぷーのひとりごと (93)
- こだわりの英語 (9)
- この歌詞、訳せますか~？ (78)
- エクセル ドット絵 (16)
- エクセル・コンテスト (28)
- エクセル関数 (64)
- メモ (1)
- 一太郎マクロ (7)
- 一太郎マクロ初心者奮戦記 (21)
- 一太郎マクロ初心者奮戦記Ⅱ (43)
- 一太郎・三四郎を語る (10)
- 一筆書き便利ツール (2)
- 三四郎マクロでゲーム作成 (3)
- 三四郎マクロ初心者奮戦記 (44)
- 三四郎関数 (53)
- 乱数 (7)
- 古い記事 (13)
- 学級通信 (6)
- 成績一覧表作成（マクロ版） (17)
- 成績処理 (5)
- 戯れで作りました・・・(^^ゞ (37)
- 提出物管理 (7)
- 教員のためのコンピュータ活用術 (49)
- 教員のための三四郎活用術（HP） (3)
- 文字列操作 (39)
- 時間割自動作成 (13)
- 表計算一筆書き (117)
- 関数で出来ますか～？ (570)
- １５パズル (22)
- ３行マクロ (16)
最近の記事
2025年8 月
| 日 | 月 | 火 | 水 | 木 | 金 | 土 |
|---|---|---|---|---|---|---|
| 1 | 2 | |||||
| 3 | 4 | 5 | 6 | 7 | 8 | 9 |
| 10 | 11 | 12 | 13 | 14 | 15 | 16 |
| 17 | 18 | 19 | 20 | 21 | 22 | 23 |
| 24 | 25 | 26 | 27 | 28 | 29 | 30 |
| 31 |
最近のコメント