Excel Maniacs

一太郎マクロ・・・くまぷーならこう作る

　さてWORD　FINDを作り終えてしまったので次のお題を考えているのだが

、何がいいだろうか？一太郎の大御所がせっかく「悪児ならこう作る」なんていう

コーナーを作ってくれているのだから、それを意識して「くまぷーならこう作る」と

いうお題はどうだろうか。

　一太郎の大御所である悪児さんが作ったものに対してくまぷー版を提示する。

神をも恐れぬ不遜な考えとお叱りを受け、あるいは失笑されそうだが、

面白そうなので敢えて挑戦してみよう。

　具体的には悪児さんの「漢字書取問題作成」マクロを扱うことにしようか・・・。

これは以前に、くまぷーが悪児さんに作ってもらったマクロである。

せっかく作ってもらったマクロなのだが、一太郎マクロの制限により、

一部満足できないところがある。それをなんとかしてみたい。

　このマクロの仕様を見て欲しい。マクロファイルの説明から引用すると

以下のようになっている。

マクロ名　「漢字書取問題作成」

機能　　問題文の中（）で囲まれた語句を順に（丸数字＋ひらがな）に

置換し、解答（元の漢字）を文末に挿入する。

実行法　対象となる文書を開き、範囲指定して、「ふりがな」－「すべての単語」を

実行してから、マクロを実行する。

メモ　　（）数は２０まで。
　　　　括弧は、全角の（）を使う。
　　　　「すべての単語」実行時に読みを確認する必要はありません。
　　　平仮名置換時に確認します。
　　　　一太郎２００５では「すべての単語」はマクロに対応していないので
　　　事前に実行しなければなりません。
　　　　なお、マクロ実行中にふりがなはすべて削除されます。

上に書いた「一部満足できない部分」とは『「ふりがな」－「すべての単語」を

実行してから、マクロを実行』しなければならないというところである。

せっかくマクロで自動処理をするのだから、この部分も自動にすることは

できないであろうか？

　大御所が敢えてこの仕様でこのマクロを公開したのだから尋常な

手段でこの部分をどうにかすることはできないであろう。
　
　しかし、盲蛇に怖じずと言われても一太郎マクロ初心者はものが

見えていない故に突き進むのであった・・・。

「漢字書取問題作成」は悪児さんのサイトからダウンロードできます。

番号は０４２です。

一太郎マクロ・・・悪児ならこう作る

　さて前に一太郎マクロの大御所悪児さんからメールを

頂いたということを書いた。あちらのサイトを覗いてみると

12月５日現在で以下の３つのマクロが登録されている。

１．アルファベットアトランダム入力
２．文字列取得
３．リスト単語降順ソート

　さすがに大御所だけのことはある。手慣れたものだ。

学ぶところは多々あるのだがその中でも特に注目したいのは

カーソルの移動である。前回書いたことだがワープロマクロを

自由に操るのに一番大切なことは文字の書き込みと

文字の読み取りである。

　文字の書き込みにはInsert()、読み取りにはGetCharacter()、

またはGetString()なのだが、一太郎マクロではカーソル位置に

文字を書き込み、カーソル位置の文字を読み取る仕様なのであるから

カーソルの移動が一太郎マクロを操る際のポイントとなる。

　そういうわけで一太郎マクロの極意はカーソルの移動にあると言っても

差し支えあるまい。

　悪児さんのコードからカーソルの移動のノウハウを頂くとしよう・・・。

一太郎マクロ・・・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

WORD_FIND06.lzhをダウンロード