[Excel VBA]Xmas Contest 2019のA-Signboard 1

atcoder.jp

クリスマスコンらしくプログラミングできなくても努力で何とかなる系の問題。

エクセル方眼紙

Private Sub Worksheet_Change(ByVal Target As Range)
    If Application.Intersect(Target, Range("A1:H8")) Is Nothing Then
        Exit Sub
    Else
        Dim c As Range
        For Each c In Target
            If c.Value < 1 Or c.Value > 64 Then
                MsgBox ("ダメ")
                Exit Sub
            End If
            Dim PicPath As String, Pic As Picture, ImageCell As Range
            PicPath = "D:\pg\AtCoder\signboard_t1\pieces\p_" & c.Value & ".png"
            Set ImageCell = c.Offset(0, 9)
            Set Pic = ActiveSheet.Pictures.Insert(PicPath)
            With Pic
                .ShapeRange.LockAspectRatio = msoFalse
                .Left = ImageCell.Left
                .Top = ImageCell.Top
                .Width = ImageCell.Width
                .Height = ImageCell.Height
            End With
        Next c
        Exit Sub
    End If

End Sub

セルのRange(A1:H8)に[1,64]を入れるとRange(J1:Q8)のセルの位置に画像が追加される仕組み。

どう考えても絶対確実に今後使わないプログラムなので保存はしないけど、なんか勿体ないのでここで供養代わりに上げておく（そのためにこれを書いている。

エクスプローラで縮小画像見ながらパズルしたけど、パワポでやるべきだったなあと思う。

Excelおじさんになりつつある。