【Word VBA】対数グラフ目盛り描画マクロ▽ソースコード

Option Explicit

Option Base 0

Public Sub 対数グラフ目盛り描画マクロ()

    Const LOGAXCNT = 5 '横方向桁目盛り数

    Const LOGAYCNT = 5 '横方向桁目盛り数

    '

    Const LOGAWIDT = 40 '桁目盛り幅

    Const LOGAHEIG = 40 '桁目盛り高

    '

    Const LOGALEFT = 80 '目盛り描画開始位置

    Const LOGATOPP = 100 '

    '---------------------------------------------------------------------------

    Dim Ip As Integer, Jp As Integer

    Dim intXps(9) As Integer, intYps(9) As Integer

    Dim intXp As Integer, intYp As Integer

    '

    '*座標テーブル

    intXps(0) = 0: intYps(0) = 0:

    For Ip = 1 To 9

        intXps(Ip) = CInt((Log(Ip) / Log(10)) * LOGAWIDT)

        intYps(Ip) = CInt((Log(Ip) / Log(10)) * LOGAHEIG)

    Next Ip

    '*垂直線描画

    For Ip = 0 To LOGAXCNT - 1

        For Jp = 0 To 9

            intXp = LOGALEFT + LOGAWIDT * Ip + intXps(Jp)

            With ActiveDocument.Shapes.AddLine(intXp, LOGATOPP,  _

                  intXp,   LOGATOPP + LOGAHEIG * LOGAYCNT).Line

                .ForeColor.RGB = vbCyan              '←線色

                .Weight = 0.75

           End With

        Next Jp

    Next Ip

    '*水平線描画

    For Ip = 0 To LOGAYCNT - 1

        For Jp = 0 To 9

            intYp = LOGATOPP + LOGAHEIG * LOGAYCNT - _

                    LOGAHEIG * Ip - intYps(Jp)

            With ActiveDocument.Shapes.AddLine(LOGALEFT, intYp, _

                    LOGALEFT + LOGAWIDT * LOGAXCNT, intYp).Line

                .ForeColor.RGB = vbCyan               '←線色

                .Weight = 0.75

           End With

        Next Jp

    Next Ip

    '*外枠

    With ActiveDocument.Shapes.AddShape(msoShapeRectangle, _

          LOGALEFT, LOGATOPP, LOGAWIDT * LOGAXCNT,  _

                                             LOGAHEIG * LOGAYCNT)

        .Fill.Visible = False:

        .Line.Visible = True

        .Line.ForeColor.RGB = vbBlue                  '←線色

        .Line.Weight = 1#

    End With

End Sub