表から数値を読み取って水位レベルを描画したい

2685 ワード
VBA PowerPoint VBA テキストリンク

やりたいこと

  • 水槽が1つある
  • 水槽には水位レベルが定められている
  • 水位レベルを正確に描画したい

↓こんな感じ

オブジェクト名を定める

  1. ホーム>選択>オブジェクトの選択と表示を開く
  2. オブジェクトに名前を付ける(水槽=>Aquarium, 水位表=>WaterTable, 線=>Lv3~Lv1)

VBA

VBA
Sub SettingWaterLvl()

    Dim shp As Shape
    Dim WaterTable As Table
    Dim Aquarium, Lv3, Lv2, Lv1 As Shape

    ' オブジェクトを設定する
    For Each shp In ActiveWindow.Selection.SlideRange.Shapes
        If shp.Name = "WaterTable" Then
            Set WaterTable = shp.Table
        ElseIf shp.Name = "Aquarium" Then
            Set Aquarium = shp
        ElseIf shp.Name = "Lv1" Then
            Set Lv1 = shp
        ElseIf shp.Name = "Lv2" Then
            Set Lv2 = shp
        ElseIf shp.Name = "Lv3" Then
            Set Lv3 = shp
        End If
    Next

    ' 表から水位レベルを読み取る
    Dim TableValues As CellRange
    Set TableValues = WaterTable.Columns.Item(2).Cells

    Dim MaxValue, Lv3Value, Lv2Value, Lv1Value, MinValue As Double
    MaxValue = CDbl(TableValues.Item(2).Shape.TextFrame.TextRange.Text)
    Lv3Value = CDbl(TableValues.Item(3).Shape.TextFrame.TextRange.Text)
    Lv2Value = CDbl(TableValues.Item(4).Shape.TextFrame.TextRange.Text)
    Lv1Value = CDbl(TableValues.Item(5).Shape.TextFrame.TextRange.Text)
    MinValue = CDbl(TableValues.Item(6).Shape.TextFrame.TextRange.Text)

    Lv3.Top = ((Aquarium.Top + Aquarium.Height) - Aquarium.Top) / (MinValue - MaxValue) * (Lv3Value - MaxValue) + Aquarium.Top
    Lv3.Left = Aquarium.Left

    Lv2.Top = ((Aquarium.Top + Aquarium.Height) - Aquarium.Top) / (MinValue - MaxValue) * (Lv2Value - MaxValue) + Aquarium.Top
    Lv2.Left = Aquarium.Left

    Lv1.Top = ((Aquarium.Top + Aquarium.Height) - Aquarium.Top) / (MinValue - MaxValue) * (Lv1Value - MaxValue) + Aquarium.Top
    Lv1.Left = Aquarium.Left

End Sub

完成