【Word VBA】ビンゴシート作成マクロ▽ソースコード

記事
IT・テクノロジー
HC220804A.png

Option Explicit
Option Base 0
'
Public Sub ビンゴシート作成マクロ()
     Const BINFNTNA = "MS 明朝"           'フォント名
     Const BINFNTSZ = 18                       'フォントサイズ
     Const BINCELWD = 56                      'テーブルセル幅
     '---------------------------------------------------------------------------
     Dim Ip As Integer, Jp As Integer, Kp As Integer
     Dim Lp As Integer
     Dim intMat(4, 4) As Integer, intNum(19) As Integer
     Dim tblBng As Table
     '
     '*ビンゴデータ作成
      Randomize Timer
      For Ip = 0 To 20 - 1
          intNum(Ip) = Ip + 1
      Next Ip
      For Jp = 0 To 5 - 1
          For Ip = 0 To 20 - 1
              Kp = Int(Rnd(1) * 20)
              If Ip = Kp Then Kp = (Ip + 1) Mod 20
              Lp = intNum(Kp): intNum(Kp) = intNum(Ip)
              intNum(Ip) = Lp
          Next Ip
          Kp = Int(Rnd(1) * 20)
          For Ip = 0 To 5 - 1
              intMat(Ip, Jp) = intNum(Kp) + Jp * 20
              If intMat(Ip, Jp) > 99 Then
                 Kp = (Kp + 1) Mod 20
                 intMat(Ip, Jp) = intNum(Kp) + Jp * 20
              End If
              Kp = (Kp + 1) Mod 20
          Next Ip
     Next Jp
     '
     '*既存の表を削除
     For Ip = ActiveDocument.Tables.Count To 1 Step -1
        ActiveDocument.Tables.Item(Ip).Delete
     Next Ip
     '*表作成
     Set tblBng = ActiveDocument.Tables.Add( _
         Range:=ActiveDocument.Range(Start:=0, End:=0), _
         NumRows:=6, NumColumns:=5)
     '
     '*表設定
     With tblBng
         .Style = "表 (格子)"
         'セル幅
         .Columns.SetWidth ColumnWidth:=BINCELWD, _
                         RulerStyle:=wdAdjustNone
         '罫線
         With .Borders
              .InsideLineStyle = wdLineStyleSingle
              .OutsideLineStyle = wdLineStyleSingle
              .InsideLineWidth = wdLineWidth100pt
              .OutsideLineWidth = wdLineWidth150pt
        End With
         '*データセット
          For Ip = 0 To 5 - 1
            With .Cell(1, Ip + 1)
                 .Range.Text = Mid("BINGO", Ip + 1, 1)
                 .Range.Font.Name = BINFNTNA
                 .Range.Font.Size = BINFNTSZ
                 .Range.ParagraphFormat.Alignment = _
                                      wdAlignParagraphCenter
                 .VerticalAlignment = wdCellAlignVerticalCenter
            End With
            For Jp = 0 To 5 - 1
                With .Cell(Ip + 2, Jp + 1)
                  If Ip = 2 And Jp = 2 Then
                     .Range.Text = "☆"
                  Else
             .Range.Text = StrConv(Format(intMat(Ip, Jp), "00"), vbWide)
                  End If
                 .Range.Font.Name = BINFNTNA
                 .Range.Font.Size = BINFNTSZ
                 .Range.ParagraphFormat.Alignment = _
                                               wdAlignParagraphCenter
                 .VerticalAlignment = wdCellAlignVerticalCenter
               End With
           Next Jp
       Next Ip
     End With
End Sub

サービス数40万件のスキルマーケット、あなたにぴったりのサービスを探す