【Word VBA】写真を並べ描画マクロ▽ソースコード

Option Explicit

Option Base 0

Public Sub 写真を並べ描画マクロ()

    Const PICUXCNT = 6                          '横方向写真数

    Const PICUYCNT = 6                          '縦方向写真数

    '

    Const PICUWIDT = 40                        '写真幅

    Const PICUHEIG = 40                         '写真高

    '

    Const PICUWIGP = 5                          '写真横隙間

    Const PICUHEGP = 3                          '写真縦隙間

    Const PICULEFT = 15                         '写真描画開始位置

    Const PICUTOPP = 20 '

    '

    Const PICUFNAM = "Cherry.png"         '写真ファイル名

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

    Dim Ip As Integer, strFna As String

    '

    strFna = ThisDocument.Path & "\" & PICUFNAM '文書と同フォルダー

    For Ip = 0 To PICUXCNT - 1

        Call ActiveDocument.Shapes.AddPicture( _

             strFna, True, True, PICULEFT+(PICUWIDT + PICUWIGP)*Ip, _

             PICUTOPP + (PICUHEIG + PICUHEGP) * 0, _

             PICUWIDT, PICUHEIG)

        Call ActiveDocument.Shapes.AddPicture( _

             strFna, True, True, PICULEFT+(PICUWIDT + PICUWIGP)*Ip, _

             PICUTOPP + (PICUHEIG + PICUHEGP) * _

             (PICUYCNT - 1), PICUWIDT, PICUHEIG)

    Next Ip

    For Ip = 0 To PICUYCNT - 1

        Call ActiveDocument.Shapes.AddPicture( _

             strFna, True, True, PICULEFT+(PICUWIDT + PICUWIGP)*0, _

             PICUTOPP + (PICUHEIG + PICUHEGP) * Ip, _

             PICUWIDT, PICUHEIG)

        Call ActiveDocument.Shapes.AddPicture( _

             strFna, True, True, PICULEFT+(PICUWIDT + PICUWIGP)* _

             (PICUXCNT - 1), PICUTOPP+(PICUHEIG + PICUHEGP)*Ip, _

             PICUWIDT, PICUHEIG)

    Next Ip

End Sub

Public Sub 写真を並べ描画マクロ2()

    Const PICUXCNT = 7 　　　　　　　 '横方向写真数

    Const PICUYCNT = 7 　　　　　　　 '縦方向写真数

    '

    Const PICUWIDT = 35　　　　　　    '写真幅

    Const PICUHEIG = 35　　　　　　     '写真高

    '

    Const PICULEFT = 15 　　　　　　 　'写真描画開始位置

    Const PICUTOPP = 20 '

    '

    Const PICUFNAM = "Myface.png"      '写真ファイル名

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

    Dim Ip As Integer, Jp As Integer

    '

    For Jp = 0 To PICUYCNT - 1

        For Ip = 0 To PICUXCNT - 1

            Call ActiveDocument.Shapes.AddPicture( _

                 ThisDocument.Path & "\" & PICUFNAM, True, True, _

                 PICULEFT + PICUWIDT * Ip, PICUTOPP + PICUHEIG * Jp, _

                 PICUWIDT, PICUHEIG)

        Next Ip

    Next Jp

End Sub