インストールレスプログラミング( ´ー`)

VBA , JavaScript , HTAなど 365アプリはインストール必要ですが、仕事に無いケースはほぼないから(・_・;)

Powerpoint VBA 表で遊ぶ その2

表をきちんと制御できるようにしようと思って,目的もなく作ってたら何かにつかえそうだったので載せます。

オセロ作れる・・?挟まれたやつの判別ルーチンができたら作れるかなぁ。

Const 全幅 = 960, 全高 = 540


Sub test()
    Dim Sld1 As Slide: Set Sld1 = ActivePresentation.Slides(1)
    Const 行数 As Long = 11, 列数 As Long = 7
    Dim 行高さ As Long, 列幅 As Long
    行高さ = 全高 / 行数
    列幅 = 全幅 / 列数
    Dim i, j
    With Sld1.Shapes.AddTable(行数, 列数, 0, 0, 全幅, 全高)
        .Name = "表"
        .Fill.ForeColor.RGB = rgbWhite
        With .Table
            .ApplyStyle "{5940675A-B579-460E-94D1-54222C63F5DA}" '"スタイルなし、表のグリッド線あり"
            For i = 0 To 行数 - 1
                For j = 0 To 列数 - 1
                    With Sld1.Shapes.AddLabel(msoTextOrientationHorizontal, j * 列幅, i * 行高さ, 列幅, 行高さ)
                        .Name = i + 1 & " " & j + 1
                        With .ActionSettings(ppMouseClick)
                            .Action = ppActionRunMacro
                            .Run = "編集"
                        End With
                        With .ActionSettings(ppMouseOver)
                            .Action = ppActionRunMacro
                            .Run = "変化"
                        End With
                    End With
                Next
            Next
        End With
    End With
    
End Sub

Sub 編集(Shp As Shape)
    Dim Sld1 As Slide: Set Sld1 = ActivePresentation.Slides(1)
    Dim arr, ret
    arr = Split(Shp.Name)
    ret = InputBox("値を入力")
    Sld1.Shapes("表").Table.Cell(arr(0), arr(1)).Shape.TextFrame.TextRange.Text = ret
End Sub

Sub 変化(Shp As Shape)
    Dim Sld1 As Slide: Set Sld1 = ActivePresentation.Slides(1)
    Sld1.Shapes("表").Fill.ForeColor.RGB = rgbWhite
    Dim arr, ret
    arr = Split(Shp.Name)
    Sld1.Shapes("表").Table.Cell(arr(0), arr(1)).Shape.Fill.ForeColor.RGB = rgbGray
End Sub

testを実行したら表を作ります。その後スライドショーにすると
f:id:chemiphys:20181025190420g:plain

ちっちゃくてすみません。表の上のセルをカーソルが動くとそこの色を変えるってだけです(;´▽`A``

とてもとても単純ですが,何かできそうな気がしますね。。