2-7-star-塗り潰しー基本

Excel  macro 

star-Fill-kihon

(以下、Sub start()以降最後まで、コピーして、Excelを開いて、star-fill-kihon.xlsmと言う名前でファイルを作り、表示クリック、マクロ開く、ここで、マクロの初期作成にためのウインドウが開きます。starとサブルーチン名を入力すると、マクロ作成画面になります。

その画面に、以下のサブルーチンをコピーして貼り付けます。上書き保存です。実行で上記、絵を描きます。）

     Sub star()

      Set RngStart = Worksheets("Sheet1").Range("B23")     ' sonomama copy    B23  ?

      xs = RngStart.Left                                   ' sonomama copy

      ys = RngStart.Top                                    ' sonomama copy

      Set RngEnd = Worksheets("Sheet1").Range("D4")        ' sonomama copy    D4  ?

      ye = RngEnd.Top                                      ' sonomama copy

      xe = xs + (ys - ye)                                  ' sonomama copy

      [A1].Select

      Dim x(37) As Double

      Dim y(37) As Double

      Dim z(37) As Double

      Dim xx(37) As Double

      Dim yy(37) As Double

      x(1) = 0#

      y(1) = 1#

      x(2) = 0.25

      y(2) = 0.5

      x(3) = 0.866

      y(3) = 0.5

      x(4) = 0.5

      y(4) = 0#

      x(5) = 0.866

      y(5) = -0.5

      x(6) = 0.25

      y(6) = -0.5

      x(7) = 0#

      y(7) = -1#

      x(8) = -0.25

      y(8) = -0.5

      x(9) = -0.866

      y(9) = -0.5

      x(10) = -0.5

      y(10) = 0#

      x(11) = -0.866

      y(11) = 0.5

      x(12) = -0.25

      y(12) = 0.5

      x(13) = 0#

      y(13) = 1#

      xmax = -100000#

      ymax = -100000#

      xmin = 100000#

      ymin = 100000#

      For i = 1 To 13            ' sonomama copy       i  ?    13 ?

      If (x(i) > xmax) Then      ' sonomama copy       i  ?

      xmax = x(i)                ' sonomama copy       i  ?

      Else                       ' sonomama copy

      End If                     ' sonomama copy

      If (x(i) < xmin) Then      ' sonomama copy       i  ?

      xmin = x(i)                ' sonomama copy       i  ?

      Else                       ' sonomama copy

      End If                     ' sonomama copy

      If (y(i) > ymax) Then      ' sonomama copy       i  ?

      ymax = y(i)                ' sonomama copy       i  ?

      Else                       ' sonomama copy

      End If                     ' sonomama copy

      If (y(i) < ymin) Then      ' sonomama copy       i  ?

      ymin = y(i)                ' sonomama copy       i  ?

      Else                       ' sonomama copy

      End If                     ' sonomama copy

      Next i                     ' sonomama copy       i  ?

      If (xmax > ymax) Then      ' sonomama copy

      ymax = xmax                ' sonomama copy

      Else                       ' sonomama copy

      xmax = ymax                ' sonomama copy

      End If                     ' sonomama copy

      If (xmin < ymin) Then      ' sonomama copy

      ymin = xmin                ' sonomama copy

      Else                       ' sonomama copy

      xmin = ymin                ' sonomama copy

      End If                     ' sonomama copy

      dx = (xe - xs) / (xmax - xmin)                  '  x  bairitu        sonomama copy

      dy = (ye - ys) / (ymax - ymin)                  '  y  bairitu        sonomama copy

      xg = (xe - xs) * (-xmin / (xmax - xmin)) + xs   '  xg  is X offset   sonomama copy

      yg = (ye - ys) * (-ymin / (ymax - ymin)) + ys   '  yg  is Y offset   sonomama copy

      icol_red = 0          '0-255

      icol_green = 255      '0-255

      icol_blue = 0         '0-255

       Xnode = x(1) * dx + xg            '   Xnode=x(1)                   sonomama copy

       Ynode = y(1) * dy + yg            '   Ynode=y(1)                   sonomama copy

       Set myBuilder = ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, Xnode, Ynode)   ' sonomama copy

       For j = 2 To 13

       Xnode = x(j) * dx + xg           '  Xnode = x(2)-x(13)             sonomama copy   j ?

       Ynode = y(j) * dy + yg           '  Ynode = y(2)-y(13)             sonomama copy   j ?

       myBuilder.AddNodes msoSegmentLine, msoEditineAuto, Xnode, Ynode                  ' sonomama copy

       Next j

       Set myShape = myBuilder.ConvertToShape                                           ' sonomama copy

       With myShape                                 ' sonomama copy

       .Fill.ForeColor.RGB = RGB(icol_red, icol_green, icol_blue)   ' area nurritubushi      ' sonomama copy

       .Line.ForeColor.RGB = RGB(icol_red, icol_green, icol_blue)   ' area gaisyuu line      ' sonomama copy

       .Line.Weight = 1.5                        ' sonomama copy

       End With                                           ' sonomama copy

      End Sub