VBA 正円同士の当たり判定用クラス

ゲームでは正確性よりもスピードが求められる場面がある。
当たり判定もその一つで、キャラ同士がぶつかったかどうかの判定は矩形や正円などに単純化して表現される。

今回Twitterで羽毛田氏がたい焼きのキャラの当たり判定の方法を模索してるようなので以下の画像を提案してみた。

キャラを正円の組み合わせで表現できれば、3×3で9通りの正円の当たり判定を行えば良いことになる。

今回はキャラ同士ではなく、正円同士がぶつかっているかどうかの判定用にクラスを書いてみた。

クラス名はCollisionSenser。
コードはこちら。

Public Name As String
Public X As Double
Public Y As Double
Public Radius As Double

Function DoesHit(c As CollisionSenser)
    DoesHit = Radius + c.Radius > CalcDiagonalDistance(Abs(X - c.X), Abs(Y - c.Y))
End Function

Private Function CalcDiagonalDistance(a, b)
    CalcDiagonalDistance = VBA.Math.Sqr(a ^ 2 + b ^ 2)
End Function

Public Property Get Self() As Object
    Set Self = Me
End Property

パブリックフィールドとして名前とX座標とY座標と半径を持たせており、当たり判定用のDoesHit関数はCollisionSenserオブジェクトを受け取って自分と当たっているかどうかを返す。

正円同士の当たりは、円の中心同士の距離が半径の合計を超えているかどうかで判定できる。

円の中心同士の距離は三平方の定理で求まる。

■三平方の定理
A^2 + B^2 = C^2

つまりC = sqr(A^2 + B^2)

以下のコードでテストしてみた。

Sub TestCollisionSenser()
    Dim CollisionSensers As Collection
    Set CollisionSensers = New Collection

    Dim sh As Shape
    For Each sh In Selection.ShapeRange
        With New CollisionSenser
            .Name = sh.Name
            .Radius = sh.Width / 2
            .X = sh.Left + .Radius
            .Y = sh.Top + .Radius
            CollisionSensers.Add .Self
        End With
    Next
    
    Dim cs1 As CollisionSenser, cs2 As CollisionSenser
    For Each cs1 In CollisionSensers
        For Each cs2 In CollisionSensers
            If Not cs1 Is cs2 Then
                If cs1.DoesHit(cs2) Then
                    Debug.Print cs1.Name & " does hit to " & cs2.Name
                End If
            End If
        Next
    Next
End Sub

複数の円を選択してコードを実行すると、

イミディエイトウィンドウに次のように表示される。

Oval 5 does hit to Oval 6
Oval 6 does hit to Oval 5
Oval 6 does hit to Oval 10
Oval 9 does hit to Oval 11
Oval 10 does hit to Oval 6
Oval 11 does hit to Oval 9

あとはキャラ用のクラスがこのCollisionSenserを必要数保持すれば複雑な形のキャラ同士でも簡易当たり判定できるかと思う。

以上

経緯

#VBA のクラスモジュールで、クラスらしいクラスを作れたためしがない😭
いつも静的クラスみたいなのばっかり。
大量の「たい焼き」を作製して、それぞれの「たい焼き」が思い思いに動く、みたいなことをしてみたい。

— チン☆テクラ (@akashi_keirin) 2018年9月7日

大量のたい焼きが動く動画。
当然、たい焼きクラスを作って、たい焼きクラスで移動を実装してます。

1匹1匹、色を変えられなかったのが残念。 pic.twitter.com/2McNfYyEIQ

— はけた＠Excel最高の学び方発売中 (@excelspeedup) 2018年9月8日

あとは、イメージの重なり判定ができれば、VBAでゲーム作れそう。

ただ、全イメージが円とか、長方形なら比較的簡単だけれど、今回の「たい焼き」のような不定形のキャラクターの重なり判定をどうしたらいいかがわからない。

いっそのこと、セルでドット絵書く方式にすればいいのかな？ https://t.co/Wkzn1Yu5M7

— はけた＠Excel最高の学び方発売中 (@excelspeedup) 2018年9月8日

MicrosoftがOfficeのクリップアートを廃止してから資料の質が向上した件

Microsoftがクリップアート廃止してからもうすぐ4年。
当時ゴリゴリのクリップアートユーザーだった私はとても残念に思っていたけれど、ふと最近資料を作っていて実はクリップアートが無い方が資料の質が上がるのでは？と感じるようになった。

当時はこういうアバター系をよく使っていたんだけど、

最近はもう、こういうので済ます。

え、ダサいって？

何を言っているんだ。この方はUML(Universal Modeling Language)に出てくるアクター様だぞ。
システムの設計ドキュメントに出てくる公式キャラ！

まぁ、正直UMLはナイス仕事をしたと思う。
「棒人間で充分じゃね？」という至高の決断。

クリップアートって綺麗なんだけど、具体的すぎて使い勝手が今一つだと感じていた。
性別・肌の色・服装といった具合に、本質と関係ない情報がごちゃごちゃと入っている。
それに比べて棒人間の抽象度は素晴らしい。純粋な概念図である。
そして手書き・デジタルともに書きやすさもピカイチ。

棒人間は一例だけど、イラストを使わない図解も上手くなってる気がする。図解の基本的な書籍で(タイトル忘れたけど)、図解の基本は文字を四角や丸で囲む、矢印で関係を表す等のシンプルなテクニックだと書いてあったのを思い出した。
つまり絵の情報に頼らない分、より本質をとらえた図解が必要になった。結果的に資料の質は上がったと思う。

クリップアートだとイメージ通りのイラストが見つからなかったり、統一感を出したいけど微妙にタッチが違うもので妥協せざるを得ないことが多く、いまいち垢抜けない資料になってしまっていたし、絶妙なイラストを探し回って時間をロスすることも多かった。

クリップアート廃止後の図解は基本的にオートシェイプで済ませている為、統一感を出しやすいし、そこまで複雑な作画はしないのでイラストをあれでもないこれでもないと漁ってた頃よりはるかにスピーディー。

更にWindows 10 以降、フラットデザインが主流になったことでクリップアートをゴテゴテに使った資料はどこか古めかしくダサい印象を受ける。

もうあの頃には戻れないなぁ。

ということで、あくまで個人の見解ではあるが、MicrosoftがOfficeのクリップアートを廃止してから資料の質が向上したと思う。

PowerPoint VBA サンプル ～ フロー図のコネクタだけ選択・複数シェイプに書かれた数字を一括インクリメント

何やらTwitterでPowerPoint VBAネタがよく流れてくるので便乗してみる。

と言っても新規ネタは無いので昔Webサイトに掲載した内容の再掲。
パワーポイントVBA - You.Activate
（サイトの方のアクセスは微量なのでなかなか日の目を見ない。）

フローチャート等でコネクタだけor画像だけを選択するマクロ

パワポでフロー図を作ることもよくあると思うけれど、後から図形の枠線だけ色を変えたいとか、コネクターの線だけ太くしたいとかいうことってよくある。

そうするためには例えばCtrl + クリックでコネクタだけをチマチマ選択していく必要があるが、数が多いととても面倒くさい。

次に紹介するマクロを使うとマウスドラッグで範囲選択した後に図形かコネクターかどちらか不要な方を一発で選択解除できる。

コードはこちら。
※このころの私はマルチバイト識別子がマイブーム

Sub 選択除外_図形のみ選択()
    Call 選択除外(True)
End Sub
 
Sub 選択除外_コネクターのみ選択()
    Call 選択除外(False)
End Sub
 
Private Sub 選択除外(非コネクター As Boolean)
     
    'シェイプが選択されていなければ、処理を中断する。
    If Not ActiveWindow.Selection.Type = ppSelectionShapes Then Exit Sub
     
    '残すシェイプのリストを準備
    Dim 残すリスト() As String
    ReDim 残すリスト(0)
     
    Dim 図 As Shape
 
    For Each 図 In ActiveWindow.Selection.ShapeRange
        If 図.Connector Xor 非コネクター Then
         
            '残すシェイプの末尾に図の名前を追記
            残すリスト(UBound(残すリスト)) = 図.Name
             
            '次の追記用にリストを1つ拡張
            ReDim Preserve 残すリスト(UBound(残すリスト) + 1)
        End If
    Next
     
    'ループで一個作りすぎるので、最後にマイナス１する
    ReDim Preserve 残すリスト(UBound(残すリスト) - 1)
    
    Dim 現在のスライド As Slide
    Set 現在のスライド = ActiveWindow.Selection.SlideRange(1)
     
    '残すリストの図形を選択しなおす。
    現在のスライド.Shapes.Range(残すリスト).Select
     
End Sub

複数シェイプ上の番号を簡単に増減する

フローチャート等でプロセスごとに番号を振っていて、例えば間にプロセスを挿入したり削除した場合、後続の番号が全部ずれ込んでチマチマ修正する羽目になる。
とても面倒なので、選択範囲のシェイプに書かれた番号を一括で増減できるマクロを作った。

Sub 番号プラス()
    Call 番号増減(1)
End Sub
 
Sub 番号マイナス()
    Call 番号増減(-1)
End Sub
 
Private Sub 番号増減(数値)
 
    'シェイプが選択されていなければ、処理を中断する。
    If Not ActiveWindow.Selection.Type = ppSelectionShapes Then Exit Sub
     
    Dim 図 As Shape
    For Each 図 In ActiveWindow.Selection.ShapeRange
        If 図.HasTextFrame Then
            If 図.TextFrame.HasText Then
                With 図.TextFrame.TextRange
                    'Asc関数にテキストを入れると1文字目の文字コードを返す。
                    'それに指定された数値を足してChrで文字に戻したあと、
                    '2文字目以降を結合。
                    .Text = Chr(Asc(.Text) + 数値) & Mid(.Text, 2)
                End With
            End If
        End If
    Next
End Sub

PowerPoint VBAでお勧めのページ

いつも隣にITのお仕事

「PowerPoint・VBA」の記事一覧 | いつも隣にITのお仕事
こちらは「ExcelVBAを実務で使い倒す技術」の著者であるタカハシさんのサイトのPowerPointカテゴリーの記事。
初心者向けに分かりやすく書かれている。

ExcelVBAを実務で使い倒す技術

Powerpoint VBAを使おう!

chemiphys.hateblo.jp
こちらは理科の教員をされているchemiphysさんのサイト。
PowerPointVBAでものすごい高度なことやってる。
特に下の2つは私の中では伝説級。

chemiphys.hateblo.jp

chemiphys.hateblo.jp

辞は達するのみ by 孔子

論語に「辞は達するのみ」という言葉がある。
これは「言葉はその意味が相手に伝わることが大事だ。」という意味だ。

孔子が何を伝えたかったかという話は、以下2通りの解釈がある。

• だから分かりやすく慎重に言葉を選択するべき
• だからいたずらに飾り立てず、些細なことに拘らず、意味の方を大事にすべき

(達してないやん。。と思ってしまうがそれは置いといて)

さて、言葉はさながら生き物のように、時代と共にその意味や解釈が移り変わる。
ところが最近SNSの発達のおかげで原義の方がまた勢力を盛り返すようになって面白い。

言葉の本来の意味を知っている人、知らない人、気に掛けるひと、掛けない人が入り混じってコミュニケーションに多少の支障を生む。SNSでは日本語警察とか、マサカリと呼ばれるアレ。

しかし、孔子が言ったように言葉は意味を伝える道具。所詮道具なので、誤用に目くじらを立てる暇があったら相手が何を言いたかったのか、言葉尻ではなく総合的に判断してきちんと「意味」を受け取るようにしたい。

人間、全ての言葉を辞書どおりに正確に話すことができるか？まぁ、無理だろう。
多少なり間違って覚えているものである。

伝える側は相手に合わせて最大限に言葉を選ぶ、受け取る側は相手の意図を理解するべく努力する。
それでうまくコミュニケーションが取れるんじゃないかと。

円滑なコミュニケーションの為には、言葉は所詮道具であることを改めて心にとめておきたい。
「伝える」「理解する」という本来の目的を忘れないよう自戒を込めてここに記す。

VBA IfやForの終了構文を自動補完するマクロ

※タイトルにつられた皆さん。多分イメージしてるものと違いますのでガッカリされないようご注意ください。

Twitterで、IfやForの終了構文を自動補完することができないのかなという疑問が投げかけられた。
VBEには文字入力を検知してマクロを走らせるような機能は無いので、たとえば If ～ Thenと書いてEnterを押すと自動でEnd Ifが入るような仕組みは作れない。
どうしてもやろうと思ったら外部のスニペットソフトを作ってグローバルキーフックという技術もあるけど、大掛かりになるし安定動作するかも分からない。

そこで方向性を変えて、Pythonっぽく終了構文なしでインデントで表されたコードを、正規のVBAコードに変換するようなマクロを書いてみた。
ただし思考実験みたいなものなので、考慮漏れしてるケースも多数あるだろうしまともにテストしていない。
それに、既に終了構文があっても追記してしまうという重大な欠陥がある。

従って、これはただのアイデア紹介のサンプルコードであり、間違ってもこのまま実務で使おうなどと考えないこと。

実行イメージ

マクロ実行前のコードがこちらだとすると、

Sub fnFizzBuzz()
    Dim ret, i
    For i = 1 To 100
        Select Case 0
            Case i Mod 15
                ret = "FizzBuzz"
            Case i Mod 3
                ret = "Fizz"
            Case i Mod 5
                ret = "Buzz"
            Case Else
                ret = CStr(i)

    fnFizzBuzz = ret
End Sub

マクロによりEnd SelectとNextが補完されたのがこちら。

Sub fnFizzBuzz()
    Dim ret, i
    For i = 1 To 100
        Select Case 0
            Case i Mod 15
                ret = "FizzBuzz"
            Case i Mod 3
                ret = "Fizz"
            Case i Mod 5
                ret = "Buzz"
            Case Else
                ret = CStr(i)
        End Select
    Next

    fnFizzBuzz = ret
End Sub

マクロでVBプロジェクトに直接アクセスする手もあるが、今回は単純にクリップボードにコードをコピーした状態でマクロを実行するとイミディエイトウィンドウに出力される仕様とした。

まず必要なのは、このブログではおなじみのStackクラス。
クラスモジュールを挿入してオブジェクト名をStackとし、以下のコードを貼り付け。

Private Items() As Variant

Property Get Count() As Integer
    Count = UBound(Items)
End Property

Property Get Top() As Variant
    Top = Items(UBound(Items))
End Property

Public Function Pop() As Variant
    If UBound(Items) > 0 Then
        Pop = Items(UBound(Items))
        ReDim Preserve Items(UBound(Items) - 1)
    Else
        Pop = Empty
    End If
End Function

Public Sub Push(ByRef x As Variant)
    ReDim Preserve Items(UBound(Items) + 1)
    Items(UBound(Items)) = x
End Sub

Private Sub Class_Initialize()
    ReDim Items(0)
End Sub

そして以下の2点を参照設定
Microsoft VBScript Regular Expressions 5.5
Microsoft Forms 2.0 Object Library

Formsの方はユーザーフォームを挿入してから削除すると参照設定されるのでそのやり方がオススメ。

そしてメインの標準モジュール(名前は任意)を挿入し、以下のコードを張り付け。

'必要な参照設定
'  Microsoft VBScript Regular Expressions 5.5
'
'  Microsoft Forms 2.0 Object Library
'  (こちらはフォームモジュール挿入して削除すれば参照設定される)
Sub FromIndentStyleToCorrectVBAStyle()
    With New DataObject
        .GetFromClipboard
        Dim arr: arr = Split(.GetText, vbNewLine)
    End With
    
    Dim StatementStack As Stack: Set StatementStack = New Stack
    Dim IndentStack As Stack: Set IndentStack = New Stack
    StatementStack.Push "Dummy"
    IndentStack.Push -1
    
    Dim i
    For i = LBound(arr) To UBound(arr)
        indents = GetIndentNumber(arr(i))
        Do While indents <= IndentStack.Top
            indents = IndentStack.Top - 4
            Debug.Print Space(IndentStack.Pop) & StatementStack.Pop
        Loop
        Debug.Print arr(i)
        es = GetEndStatement(arr(i))
        If es <> "" Then
            StatementStack.Push es
            IndentStack.Push indents
        End If
    Next
End Sub

Function GetIndentNumber(codeLine)
    Dim n: n = 1
    Do While Mid(codeLine, n, 1) = " "
        n = n + 1
    Loop
    n = n - 1
    GetIndentNumber = n
End Function

Function GetEndStatement(ByVal begin)
    Dim ret As String
    
    Dim re As RegExp: Set re = New RegExp
    begin = Trim(begin)
    
    re.Pattern = "^For .*"
    If re.Test(begin) Then
        ret = "Next": GoTo Fin
    End If
    
    re.Pattern = "^If .* Then$"
    If re.Test(begin) Then
        ret = "End If": GoTo Fin
    End If
    
    re.Pattern = "^Select Case "
    If re.Test(begin) Then
        ret = "End Select": GoTo Fin
    End If
    
    re.Pattern = "^Do"
    If re.Test(begin) Then
        ret = "Loop": GoTo Fin
    End If
    
Fin:
    GetEndStatement = ret
End Function

後はPythonみたいにインデントのみで書かれたコードをコピーして、FromIndentStyleToCorrectVBAStyleを実行すると、終了構文が補完されたコードがイミディエイトウィンドウに出力される。

一応作ってみたものの、私自身は毎日VBAに触ってるのであまりタイピングが面倒という感覚がなくなってきている。
ツール作成で一番時間を食うのは試行錯誤やデバッグなので、タイピングのロスは誤差の範囲。
だからまぁ、これを自分で使うことは無いだろうなぁ。

追記(言い訳)

今回はとりあえずアイデアを形にするためのやっつけコーディングなので、より良い方法があっても突っ込まないで欲しい。
たとえばスタックを2個使ってるけど、本当は関連項目だからユーザー定義型かクラスにしてデータをまとめて1つのスタックに積むか、スタック自体を改変して複数個を1領域にPushできる仕様にすべきだったと思う。
※Popが多値になるのでそれはそれで扱い注意だけど。

それと、冒頭で述べた既に終了構文があっても追記してしまうという重大な欠陥について、修正できなかった訳じゃないけど、このアイデアにそれほど思い入れが無いので放置することにした。もしこのアイデアを気に入った人がいたら直して使って欲しい。

部屋を綺麗に保つために大事な「運用」という観点

断捨離とかミニマリストとかがもてはやされていた頃、なんとなく感じた違和感。
それは私がシステムの運用に携わっているためかもしれない。

一度開発されたシステムは、その後何年にもわたって運用されていく。
作って終わりではないのだ。

私は、お部屋の片付け・掃除は片付いた状態を作る「開発」作業だと思っている。
重要なのはその片付いた状態をどうやって維持、つまり「運用」していくか。

どれだけ綺麗な部屋を完成させても、日々ゴミは出るしホコリもたまる。
片付けられない男女に必要なのは、「開発」ではなくて「運用」の方なんじゃないか。

これが断捨離やミニマリストに対して感じていた違和感の正体だった。

まぁ、以下のようなタイプには効くと思うし、不要なものを捨てることは大事だと思う。

ただ、一発綺麗にしたいだけならお金を払って業者になんとかしてもらうという手もある。

片付けられない人の悩みって、以下のタイプが多いんじゃないだろうか。
※これは極端な例だけど、波が激しいという意味では当てはまる人多いと思う。

まぁ一発奮起して片付けする人ってこんな状態↓を目指すんだろうけど、そんなこと出来る人ってそうそう居ないし、運用考える前に開発始めちゃう感じなので、数日で元の木阿弥になるのは目に見えている。

それよりは、こんな感じ↓で「そこそこ綺麗」を通年運用していく方が快適に暮らせるだろうし、まずは運用から考えた方が良いなと最近思うようになった。

なんかボヤっとした話になってしまったので一つだけ改善した事例を挙げる。
以前私は、飲み終わったペットボトルを台所に置いてて、たまってからラベル剥いて洗って捨てるってことをしてた。私は全く料理をしないので、台所は完全にペットボトル置き場と化していた。

ところが溜まったボトルを全部ラベルを剥いて洗うのって面倒くさいのでつい後回しになる。結果、空ペットボトルが台所以外にも浸食。ペットボトルってフタを閉めておけば臭いもしないし、中身が多少残ってても汚れないので、男の一人暮らしで散乱しやすいものダントツ一位だと思われる。

これはさすがにまずいってことで、以前ポタペットというアイテムを買って、飲んだら洗ってすぐ干すようにした。

ポタペット グリーン

翌朝まずまず乾いてるので多少水滴あってもそのままこちらにポイ。

サンコープラスチック ゴミ箱 2段分別スリム 47L ライトベージュ

ゴミ箱のデザインは今一つ気に入らないんだけど、まぁ取り合えず運用重視。
捨てたときにゴミ箱に水が垂れるようなことがなければ良いので、完全に乾いてなくてもOKとした。

結果、台所はもちろん部屋にペットボトルが転がっているという事態はなくなった。

極端なミニマリストの考え方だと、まずポタペットって無くても良いので捨てるor買わない。専用のごみ箱もゴミ袋があればいいよねって話になるので買わないor捨てるという風になるんじゃないかと。でもそこには運用の観点が抜け落ちてる。

経験上、運用を考慮していないところから汚れていくので、運用を支えるアイテムは迷わず買うべきだと思うし、部屋を片付ける際も一番に考えるべきはどうやって維持していくかということだと思う。

以下、お気に入りの片づけ本。

片づけられない女のためのこんどこそ!片づける技術

これは捨てる系の本だけど、基地を作るという考え方が役に立った。一か所綺麗だと他の汚れが気になってくるもの。だからとりあえず机だけは死守しよう。この考え方を取り入れることでとりあえず部屋全体がそこそこ綺麗な状態を維持できるようになった。

同じ著者で、今度は整頓系の本。

必要なものがスグに! とり出せる整理術!

具体的なアイデアよりは、考え方が参考になった。要は「取り出しにくい・しまいにくい」収納が、元の位置に戻さなくなる元凶。
使いやすさ≒運用を重視して設計することですぐ片付けられる部屋になる。

あと細々やりすぎないってところもミソ。私の場合は以下のチェストに文房具・薬/サプリ・衛生/身だしなみ・工具類ってくくりでゴチャーっと入れてる。

アイリスオーヤマ チェスト スーパークリア 10段 幅32×奥行39×高さ108.4cm ホワイト/クリアブルー SCE-1000

ちょっとチープでダサいかなぁと思ったけど、片付けが苦手な人はオシャレでシックなアイテムよりも、とにかく運用重視で揃えると良い。
どんなオシャレなアイテムも、汚部屋では台無しなので、片付け初心者を脱するまでは何を買っても一緒。
きちんと運用が定まってから高級感のあるものにアップグレードするのは良いと思う。

VBA 複雑な罫線をVBAで描き分ける

Twitterでお題が流れてきたので乗っかってみた。

方眼紙Excelの正しい使い方。 pic.twitter.com/a05wFJpatH

— waenavi (@waenavi_jp) 2018年8月31日

これの本人返信ツイートでマクロは禁止ですと書いてあったんだけど気にせずにマクロ記述時間込みでトライアル。

結果、マクロ記述と実行を合われて4分15秒で完成。記述込みだとマクロ使って1分は逆に無理だな。。

書いたマクロはこちら。

Sub hoge()
    Dim r As Range
    For Each r In Selection
        If r.Interior.Color = vbYellow Then
            r.Borders.LineStyle = XlLineStyle.xlContinuous
            If r.Offset(1, 0).Interior.Color = vbYellow Then r.Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlDash
            If r.Offset(0, 1).Interior.Color = vbYellow Then r.Borders(xlEdgeRight).LineStyle = XlLineStyle.xlDash
            If r.Offset(-1, 0).Interior.Color = vbYellow Then r.Borders(xlEdgeTop).LineStyle = XlLineStyle.xlDash
            If r.Offset(0, -1).Interior.Color = vbYellow Then r.Borders(xlEdgeLeft).LineStyle = XlLineStyle.xlDash
        End If
    Next
End Sub

使い方

まず手動で描きだしたいセルをCtrl+ドラッグやCtrl+クリックで選択する。

それを黄色く塗りつぶす。

あとは塗りつぶした範囲が入るように適当に範囲選択して、

マクロを実行すると、こうなる。

最後に全選択して塗りつぶしをクリアし、表示メニューから枠線を消すとできあがり。

お題と形違うけど。。まぁ趣旨は合ってるからいいや。

以上

追記

元記事がはてなブログだったようなので引用
www.waenavi.com