エクセラのEXCEL
表計算ソフトEXCELでゲーム等を作っています。ゲーム等の作成状況を紹介。
スポンサーサイト
上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。
VBAで動くXEVIOUSもどきゲームをアップ
エクセル上でゼビウスもどきのゲームを作成してきましたが、オープニングを追加し、とりあえず完成したところまでを
ここ(http://www.geocities.jp/exceler_z/)にアップしました。
まだ1面しかありません。
EXCEL2016がないと動作しませんのでご注意を。i7-3GHz以上でないと動きが遅いかも。
要望が多ければキャラならびに面を追加します。
スポンサーサイト
EXCEL2016でゼビウスもどき
ホームページは
http://www.geocities.co.jp/SiliconValley-Sunnyvale/9554/
から
http://www.geocities.jp/exceler_z/
へ変更したが、昔の方がアクセス数が多い。
最新のVBAは昔の方には置いていないので、新しい方へ。

EXCELのバージョンを2013から2016へ変更した。
これまで作成したパックマンやニューラリーXもどきのゲームマクロは画面が少しずれている。
さらにVBAの動作が遅くなった気がする。
ゼビウスもどきのゲームはEXCEL2016では、遅いため仕様を次の通り大幅に変更した。
EXCEL2013では、セル1個を1ドットに見立ててマップをスクロールさせていた。
EXCEL2016では、遅すぎるため、マップは背景として画像を挿入し、地上物はセルで、上空物はシェイプと3つを使ってゲーム画面を構成している。
なんとか1面が完成した。地上物はソルやスペシャルフラッグ含めて作成したが、上空物はトーロイド(コイン)までとなっている。
EXCEL2016でないと、ちゃんと表示されないが、なんとかゼビウスぽいゲームがEXCEL上で動くようになった。
XEVIOUもどき
EXCELマクロでゼビウスもどき
PCの中を整理していたら、作り掛けのエクセルファイルが出てきた。
ゼビウスもどきだった。動かしてみるとマップは多くのオートシェイプから構成されているため、ちらつきが激しかった。
本日、時間があったので、セルを小さくし、ドットとしてマップを作成した。動かしてみるとスムーズに動いた。
下の画像の1つ目が元のオートシェイプ版、2つ目が本日のセル版。
この方法ならゼビウスもどきのゲームがエクセルで作れるかも。
だが時間が無い。。。。

オートシェープ
試作

テーマ:EXCEL - ジャンル:コンピュータ

EXCEL2013へ対応
これまで作成してきたEXCELゲーム(VBA)を動かしてみると、EXCEL2013では仕様が変わっており動かなかった。
そこで、次の2つを動くように修正と、さぼって省略していた部分を追加した。

①PEXCELMAN(パックマンもどき)
 オープニングの追加
 コーヒーブレーク(3種類)の追加
 その他微調整
pexcelmanオープニング
pexcelmanゲーム
pexcelmanコーヒーブレーク


②NEW RALLY EXCEL(ニューラリーXもどき)
 オープニングの追加
 チャレンジングステージの追加
 音楽の追加
 その他微調整
RALLY-EXCELオープニング
RALLY-EXCELゲーム
RALLY-EXCELチャレンジングステージ


作品は
http://www.geocities.jp/exceler_z/
でダウンロードできます。
EXCEL2000でも動きます。
BEEPの有効活用?

季節外れの蚊に悩まされていた。
蚊の嫌いな周波数を発生するソフトがあったことを思い出し、蚊の嫌がる周波数を調べて見た。
周波数を調べているうちに、他の動物の嫌がる周波数も分かってきた。
エクセルの作業中に蚊や他の動物達の邪魔をさせないと思い、いろんな周波数を発生するマクロを作成した。
途中、こんなボタンを押すことは無いんだろうなーと思いながらも片っぱしから登録した。
登録したのは蚊、ねずみ、ゴキブリ、猫&犬、モグラ、鳩の計6種類。
とりあえず周波数の発生時間は1000msとしているので、もっと長いほうが良いのならbeepの最後の数字を増やして下さい。
効果の確認はまだなので、効果を確認できた人は是非メールを下さい(笑)。


Declare Function beep Lib "kernel32" Alias "Beep" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

Sub mosquito() '蚊
    beep Rnd * 3000 + 6000, 1000
End Sub

Sub rat() 'ねずみ
    beep Rnd * 30000 + 30000, 1000
End Sub

Sub cockroach() 'ゴキブリ
    beep Rnd * 3000 + 22000, 1000
End Sub

Sub cat_and_dog() '猫、犬
    beep Rnd * 5000 + 18000, 1000
End Sub

Sub mole() 'モグラ
    beep Rnd * 70 + 280, 1000
End Sub

Sub pigeon() '鳩
    beep Rnd * 10000 + 20000, 1000
End Sub

End Sub



人間が聞くことが出来る音波の周波数は20~20,000Hzであるが、beepで周波数を変えて聞いてみたところ36~13,750Hzしか聞こえなかった。私の耳が悪いのか、それともPCの内臓スピーカが悪いのか?

テーマ:EXCEL - ジャンル:コンピュータ

面積率測定

白黒の写真から白色の面積率を求めることがある。
今まで、
(1)写真をスキャン(JPEG)
(2)JPEGをビットマップ(BMP)化
(3)2値化
(4)エクセルのマクロで面積率を求める
といった工程であった。
(2)から(4)は3つのアプリケーションを用いており、非常に操作性が悪かった。
そこで今回(2)から(4)をエクセルだけで出来るように(4)を大幅に改造した。
 エクセルが扱えられる画像ファイル(JPEG,BMP,GIF,TIFF,etc)ならなんでもOK。
 カラーを白黒に加工する必要もなし。
 2値化の境界もエクセルからできる。
マクロの内容は
 白黒化:図の書式設定-図-イメージコントロールの色→白黒
 2値化の境界変更:イメージコントロールの明るさを変更
 計算用ビットマップの作成:画像ファイルを一旦コピーすることで、ビットマップファイルにする。
              クリップボードにあるビットマップをファイル化
 ビットマップの解析:白色の点の個数をカウント


計算用ビットマップファイルの作成はエクセルの基本機能ではできず、APIの塊となった。
使用したAPIは次の通り。
 GlobalLock
 GlobalUnlock
 GlobalSize
 CreateFile
 CloseHandle
 WriteFile
 MoveMemory
 OpenClipboard
 CloseClipboard
 GetClipboardData


マクロは*HP*内のの面積率測定2です。
従来は面積測定もあります。
マクロはエクセル上でAlt+F11で見ることが出来ます。

テーマ:EXCEL - ジャンル:コンピュータ

ダイエット

グラフィックエディター等から、画像をコピーし、それをエクセルへ貼り付けると、ビットマップ形式で貼りつくため、ファイル容量が膨大となる。そこで、貼り付けた画像をJPEGにするマクロを作ってみた。
コードを実行すると、対象ファイルを選択し、ブック内の貼り付けた画像を、JPEGに変更し、ファイル名に(diet)をつけて保存します。
なお、グループ化した画像は対象外となります。JPEG形式からGIF形式にする場合は、コードの
ActiveSheet.PasteSpecial Format:="図 (JPEG)"

ActiveSheet.PasteSpecial Format:="図 (GIF)"
に変更するだけ。


Sub test()
    fn = Application.GetOpenFilename("ファイル (*.xls),*.xls", , "対象のファイルを開いてください")
    Application.ScreenUpdating = False
    If fn <> False Then
        Workbooks.Open Filename:=fn
        For Each ws In ActiveWorkbook.Sheets
            Sheets(ws.Name).Select
            For Each ss In ActiveSheet.Shapes
                If InStr(ss.Name, "Object") Then
                    ActiveSheet.Shapes(ss.Name).Select
                    x = Selection.ShapeRange.Left
                    y = Selection.ShapeRange.Top
                    Selection.ShapeRange.Line.Visible = msoFalse
                    Selection.Cut
                    ActiveSheet.PasteSpecial Format:="図 (JPEG)"
                    Selection.ShapeRange.Left = x + 10
                    Selection.ShapeRange.Top = y + 10
                End If
            Next
        Next
        ff = Mid(fn, InStrRev(fn, "\") + 1): ff = Left(ff, InStrRev(ff, ".") - 1) & "(diet).xls"
        ActiveWorkbook.SaveAs Filename:=Left(fn, InStrRev(fn, ".") - 1) & "(diet).xls"
        Windows(ff).Close
    End If
    Application.ScreenUpdating = True
End Sub


コードの入力が大変な方は、*HP*の右下のpic_dietをダウンロードして下さい。

テーマ:EXCEL - ジャンル:コンピュータ

再計算可能なセル変更関数

先日の関数を再計算にも対応させた。
あまりすっきりしたコードではないけど、名前定義を利用して、関数もどきの再計算をさせている。


'標準モジュール
'使用例 =rotate(対象のセル範囲,回転角) 回転角は-90~90
Function rotate(a As Range, b)
    rotate = a.Address & "," & b
End Function


'シートモジュール
Private Sub Worksheet_Calculate()
    Dim a As Variant
    For Each n In ActiveWorkbook.Names
        If n.Name Like "rotate_*" Then
            f = Range(n.Name).Formula
            If f Like "*rotate(*,*)*" Then
                a = Split(Range(n.Name), ",")
                Range(a(0)).Orientation = a(1)
            End If
        End If
    Next
End Sub


Private Sub Worksheet_Change(ByVal target As Range)
    Dim a As Variant
    For Each ta In target
        f = ta.Formula
        If f Like "*rotate(*,*)*" Then
            a = Split(ta, ",")  'a(0)は対象のセル a(1)は回転角
            Range(a(0)).Orientation = a(1)
            ActiveWorkbook.Names.Add Name:="rotate_" & Replace(ta.Address, "$", ""), RefersTo:="=" & ta.Address
        End If
    Next
End Sub

テーマ:EXCEL - ジャンル:コンピュータ

ユーザー定義関数でセルの内容を変更

関数でセルの内容を変更することはできませんが、以前、ユーザー定義関数(?)で強引にセルの内容を変更したことがあります。
次の例は、特定のセルの文字を回転させる関数(?)です。
なお再計算時には反映されません。

'標準モジュール
'使用例 =rotate(対象のセル範囲,回転角) 回転角は-90~90
Function rotate(a As Range, b As Long)
    rotate = a.Address & "," & b
End Function


'シートモジュール
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim a As Variant
    For Each ta In Target
        f = ta.Formula
        If f Like "*rotate(*,*)*" Then
            a = Split(ta, ",")  'a(0)は対象のセル a(1)は回転角
            Range(a(0)).Orientation = a(1)
        End If
    Next
End Sub

テーマ:EXCEL - ジャンル:コンピュータ

クイズ・ドレミファドン!
APIのBEEPを使うと、EXCELで音楽を流すことができます。
果たして何の曲が流れてくるでしょうか?
やり方のわからない人は、メール下さい。

Declare Function beep Lib "kernel32" Alias "Beep" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub sound()
Dim a()
a = [{32,5,0,2,24,2,32,2,40,2,48,2,40,2,0,2,32,2,36,2,0,2,36,2,36,2,0,2,27,5,0,1,36,2,32,2,0,2,30,2,32,5,0,2,24,2,32,2,40,2,48,2,40,2,0,2,32,2,34,2,0,2,34,2,34,2,0,2,32,5}]
For i = 1 To UBound(a) Step 2
If a(i) = 0 Then
Sleep a(i + 1) * 80
Else
beep a(i) * 10, a(i + 1) * 80
End If
Next
End Sub
copyright © 2005 エクセラのEXCEL all rights reserved.
Powered by FC2ブログ.
上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。