{"id":2412,"date":"2022-06-07T06:20:31","date_gmt":"2022-06-06T21:20:31","guid":{"rendered":"http:\/\/oreoreki.gotdns.ch\/?p=2412"},"modified":"2022-06-07T06:38:55","modified_gmt":"2022-06-06T21:38:55","slug":"post-2412","status":"publish","type":"post","link":"http:\/\/oreoreki.gotdns.ch\/?p=2412","title":{"rendered":"VBA\u3067\u6570\u5b66\u306e\u6559\u79d1\u66f8\u306b\u3042\u308b\u3088\u3046\u306a\u7acb\u4f53\u56f3\u5f62\u3092\u63cf\u304f"},"content":{"rendered":"<p><span class=\"embed-youtube\" style=\"text-align:center; display: block;\"><iframe loading=\"lazy\" class=\"youtube-player\" width=\"750\" height=\"422\" src=\"https:\/\/www.youtube.com\/embed\/yG0rIs8J83w?version=3&#038;rel=1&#038;showsearch=0&#038;showinfo=1&#038;iv_load_policy=1&#038;fs=1&#038;hl=ja&#038;autohide=2&#038;wmode=transparent\" allowfullscreen=\"true\" style=\"border:0;\" sandbox=\"allow-scripts allow-same-origin allow-popups allow-presentation allow-popups-to-escape-sandbox\"><\/iframe><\/span><\/p>\n<div class=\"hcb_wrap\">\n<p>ExcelVBA\u3067\u6570\u5b66\u306e\u6559\u79d1\u66f8\u306b\u3042\u308b\u3088\u3046\u306a\u7acb\u4f53\u56f3\u5f62\u3092\u63cf\u3044\u3066\u307f\u305f<br \/>\n<span class=\"bold-red\">\u3053\u306e\u52d5\u753b\u306e\u30de\u30af\u30ed\u306fWindows11\/Office2013\u3067\u4f5c\u6210\u3057\u3066\u307e\u3059\u3002<br \/>\n<\/span><\/p>\n<h2><\/h2>\n<pre class=\"prism line-numbers lang-ts\" data-lang=\"TypeScript\"><code>Sub Macro_Ex_Wd_Pp()\r\n    Dim myDocument\r\n    Dim i, x, y, r, h\r\n    \r\n    'Word,Excel,Powerpoint\u3069\u308c\u3067\u3082\u52d5\u304f\u3088\u3046\u306b\u3059\u308b\r\n    Select Case True\r\n        Case Application.Caption = \"Word\"\r\n            Set myDocument = ActiveDocument\r\n        Case InStr(Application.Caption, \"Excel\") > 0\r\n            Set myDocument = ActiveSheet\r\n        Case Else\r\n            Set myDocument = ActivePresentation.Slides(1)\r\n    End Select\r\n\r\n    '\u4eca\u3042\u308b\u56f3\u5f62\u3092\u6d88\u3059\r\n    For i = myDocument.Shapes.Count To 1 Step -1\r\n         myDocument.Shapes(i).Delete\r\n    Next i\r\n\r\n    '\u56f3\u5f62\u306e\u8868\u793a\u4f4d\u7f6e\u3001\u534a\u5f84\u3001\u9ad8\u3055\r\n    x = 150:   y = 200\r\n    r = 100:    h = 100\r\n    \r\n    '\u7403\u3001\u5186\u67f1\u3001\u5186\u9310\r\n    Call Ball(myDocument, x, y, r)\r\n    Call Cylinder(myDocument, x, y, r, h)\r\n    Call Cone(myDocument, x, y, r, h)\r\n    \r\n    '\u7acb\u65b9\u4f53\u3001\u56db\u89d2\u9310\u3001\u4e09\u89d2\u9310\r\n    x = 500:    y = 100\r\n    Call Cube(myDocument, x, y, r)\r\n    y = 250\r\n    Call Pyramid(myDocument, x, y, r)\r\n    y = 350\r\n    Call Tetrahedron(myDocument, x, y, r)\r\n\r\nEnd Sub\r\n\r\nFunction Ball(obj, x, y, r)\r\n    '\u7403\u3092\u63cf\u753b\r\n    ' obj \u63cf\u753b\u3059\u308b\u30aa\u30d6\u30b8\u30a7\u30af\u30c8\r\n    ' \u4e2d\u5fc3(x,y) \u534a\u5f84r\r\n    Dim SN(0 To 2) As Variant\r\n    Dim shp, a\r\n    \r\n    a = 0.3\r\n    \r\n    '\u534a\u5f84\r\n    'Set shp = obj.Shapes.AddConnector(msoConnectorStraight, x, y + r * a \/ 8, x + r, y + r * a \/ 8)\r\n    \r\n    '\u8d64\u9053\u306e\u88cf\u5074\r\n    If Application.Caption <> \"Word\" Then\r\n        Set shp = obj.Shapes.AddShape(msoShapeArc, x, y - r \/ 4, r, r * a)  '\u30a8\u30af\u30bb\u30eb\u30fb\u30d1\u30ef\u30dd\u306e\u5834\u5408\r\n    Else\r\n        Set shp = obj.Shapes.AddShape(msoShapeArc, x - r, y - r \/ 8, r * 2, r * a) '\u30ef\u30fc\u30c9\u306e\u5834\u5408\r\n    End If\r\n    SN(0) = shp.Name\r\n    shp.Adjustments.Item(1) = 180\r\n    shp.Adjustments.Item(2) = 0\r\n    lineattr shp, msoLineDash, 2    '\u7834\u7dda\r\n    '\u8d64\u9053\u306e\u8868\u5074\r\n    If Application.Caption <> \"Word\" Then\r\n        Set shp = obj.Shapes.AddShape(msoShapeArc, x, y - r \/ 4, r, r * a)  '\u30a8\u30af\u30bb\u30eb\u30fb\u30d1\u30ef\u30dd\u306e\u5834\u5408\r\n    Else\r\n        Set shp = obj.Shapes.AddShape(msoShapeArc, x - r, y - r \/ 8, r * 2, r * a) '\u30ef\u30fc\u30c9\u306e\u5834\u5408\r\n    End If\r\n    SN(1) = shp.Name\r\n    shp.Adjustments.Item(1) = 0\r\n    shp.Adjustments.Item(2) = 180\r\n    lineattr shp, msoLineSolid, 2\r\n    '\u5916\u5468\r\n    Set shp = obj.Shapes.AddShape(msoShapeOval, x - r \/ 1, y - r \/ 1, r * 2, r * 2)\r\n    SN(2) = shp.Name\r\n    shp.Fill.Visible = msoFalse '\u5186\u306e\u5857\u308a\u3064\u3076\u3057\u306a\u3057\r\n    lineattr shp, msoLineSolid, 2\r\n\r\n    '\u30b0\u30eb\u30fc\u30d7\u5316\r\n    obj.Shapes.Range(SN).Group.Name = \"\u7403\"\r\n    Set Ball = shp\r\nEnd Function\r\n\r\nFunction Cylinder(obj, x, y, r, h)\r\n    '\u5186\u67f1\u3092\u63cf\u753b\r\n    ' obj \u63cf\u753b\u3059\u308b\u30aa\u30d6\u30b8\u30a7\u30af\u30c8\r\n    ' \u4e0a\u9762\u4e2d\u5fc3(x,y) \u534a\u5f84r\r\n    'y > h+r\/2\u3067\u3042\u308b\u3079\u304d\r\n    Dim SN(0 To 4) As Variant\r\n    Dim shp, a\r\n    a = 0.3     '\u6955\u5186\u306e\u6f70\u308c\u5177\u5408\r\n\r\n    '\u534a\u5f84\r\n    'Set shp = obj.Shapes.AddConnector(msoConnectorStraight, x, y + r * a \/ 8, x + r, y + r * a \/ 8)\r\n    \r\n    '\u4e0a\u9762\r\n    If Application.Caption <> \"Word\" Then\r\n        Set shp = obj.Shapes.AddShape(msoShapeArc, x, y - r \/ 4, r, r * a) '\u30a8\u30af\u30bb\u30eb\u30fb\u30d1\u30ef\u30dd\u306e\u5834\u5408\r\n    Else\r\n        Set shp = obj.Shapes.AddShape(msoShapeArc, x - r, y - r \/ 8, r * 2, r * a)  '\u30ef\u30fc\u30c9\u306e\u5834\u5408\r\n    End If\r\n    SN(0) = shp.Name\r\n    shp.Adjustments.Item(1) = 0\r\n    shp.Adjustments.Item(2) = 360\r\n    lineattr shp, msoLineSolid, 2\r\n   \r\n    '\u5e95\u9762\u306e\u88cf\u5074\r\n    If Application.Caption <> \"Word\" Then\r\n        Set shp = obj.Shapes.AddShape(msoShapeArc, x, y - r \/ 4 + h, r, r * a) '\u30a8\u30af\u30bb\u30eb\u30fb\u30d1\u30ef\u30dd\u306e\u5834\u5408\r\n    Else\r\n        Set shp = obj.Shapes.AddShape(msoShapeArc, x - r, y - r \/ 8 + h, r * 2, r * a) '\u30ef\u30fc\u30c9\u306e\u5834\u5408\r\n    End If\r\n    SN(1) = shp.Name\r\n    shp.Adjustments.Item(1) = -180\r\n    shp.Adjustments.Item(2) = 0\r\n    lineattr shp, msoLineDash, 2\r\n    '\u5e95\u9762\u306e\u8868\u5074\r\n    If Application.Caption <> \"Word\" Then\r\n        Set shp = obj.Shapes.AddShape(msoShapeArc, x, y - r \/ 4 + h, r, r * a) '\u30a8\u30af\u30bb\u30eb\u30fb\u30d1\u30ef\u30dd\u306e\u5834\u5408\r\n    Else\r\n        Set shp = obj.Shapes.AddShape(msoShapeArc, x - r, y - r \/ 8 + h, r * 2, r * a) '\u30ef\u30fc\u30c9\u306e\u5834\u5408\r\n    End If\r\n    SN(2) = shp.Name\r\n    shp.Adjustments.Item(1) = 0\r\n    shp.Adjustments.Item(2) = 180\r\n    lineattr shp, msoLineSolid, 2\r\n    \r\n    '\u53f3\u306e\u7dda\r\n    Set shp = obj.Shapes.AddConnector(msoConnectorStraight, x - r, y + r * a \/ 8, x - r, y + r * a \/ 8 + h)\r\n    SN(3) = shp.Name\r\n    lineattr shp, msoLineSolid, 2\r\n    \r\n    '\u5de6\u306e\u7dda\r\n    Set shp = obj.Shapes.AddConnector(msoConnectorStraight, x + r, y + r * a \/ 8, x + r, y + r * a \/ 8 + h)\r\n    SN(4) = shp.Name\r\n    lineattr shp, msoLineSolid, 2\r\n\r\n    '\u30b0\u30eb\u30fc\u30d7\u5316\r\n    obj.Shapes.Range(SN).Group.Name = \"\u5186\u67f1\"\r\n    Set Cylinder = shp\r\nEnd Function\r\n\r\nFunction Cone(obj, x, y, r, h)\r\n    '\u5186\u9310\u3092\u63cf\u753b\r\n    ' obj \u63cf\u753b\u3059\u308b\u30aa\u30d6\u30b8\u30a7\u30af\u30c8\r\n    ' \u9802\u70b9(x,y) \u534a\u5f84r\r\n    ' y > h\u3067\u3042\u308b\u3079\u304d\r\n    Dim SN(0 To 3) As Variant\r\n    Dim shp, a\r\n    a = 0.3     '\u6955\u5186\u306e\u6f70\u308c\u5177\u5408\r\n    \r\n    '\u534a\u5f84\r\n    'Set shp = obj.Shapes.AddConnector(msoConnectorStraight, x, y + r * a \/ 8 + h, x + r, y + r * a \/ 8 + h)\r\n    \r\n    '\u5e95\u9762\u306e\u88cf\u5074\r\n    If Application.Caption <> \"Word\" Then\r\n        Set shp = obj.Shapes.AddShape(msoShapeArc, x, y - r \/ 4 + h, r, r * a) '\u30a8\u30af\u30bb\u30eb\u30fb\u30d1\u30ef\u30dd\u306e\u5834\u5408\r\n    Else\r\n        Set shp = obj.Shapes.AddShape(msoShapeArc, x - r, y - r \/ 8 + h, r * 2, r * a) '\u30ef\u30fc\u30c9\u306e\u5834\u5408\r\n    End If\r\n    SN(0) = shp.Name\r\n    shp.Adjustments.Item(1) = 180\r\n    shp.Adjustments.Item(2) = 0\r\n    lineattr shp, msoLineDash, 2\r\n    '\u5e95\u9762\u306e\u8868\u5074\r\n    If Application.Caption <> \"Word\" Then\r\n        Set shp = obj.Shapes.AddShape(msoShapeArc, x, y - r \/ 4 + h, r, r * a) '\u30a8\u30af\u30bb\u30eb\u30fb\u30d1\u30ef\u30dd\u306e\u5834\u5408\r\n    Else\r\n        Set shp = obj.Shapes.AddShape(msoShapeArc, x - r, y - r \/ 8 + h, r * 2, r * a) '\u30ef\u30fc\u30c9\u306e\u5834\u5408\r\n    End If\r\n    SN(1) = shp.Name\r\n    shp.Adjustments.Item(1) = 0\r\n    shp.Adjustments.Item(2) = 180\r\n    lineattr shp, msoLineSolid, 2\r\n\r\n    '\u7a1c\u7dda(\u5de6)\r\n    Set shp = obj.Shapes.AddConnector(msoConnectorStraight, x, y, x - r, y + r * a \/ 8 + h)\r\n    SN(2) = shp.Name\r\n    lineattr shp, msoLineSolid, 2\r\n    \r\n    '\u7a1c\u7dda(\u53f3)\r\n    Set shp = obj.Shapes.AddConnector(msoConnectorStraight, x, y, x + r, y + r * a \/ 8 + h)\r\n    SN(3) = shp.Name\r\n    lineattr shp, msoLineSolid, 2\r\n    \r\n    '\u30b0\u30eb\u30fc\u30d7\u5316\r\n    obj.Shapes.Range(SN).Group.Name = \"\u5186\u9310\"\r\n    Set Cone = shp\r\nEnd Function\r\n\r\nFunction Cube(obj, x, y, r)\r\n    '\u7acb\u65b9\u4f53\u3092\u63cf\u753b\r\n    ' obj \u63cf\u753b\u3059\u308b\u30aa\u30d6\u30b8\u30a7\u30af\u30c8\r\n    ' \u91cd\u5fc3(x,y,0) 1\u8fba\u306e\u9577\u3055 r\r\n    \r\n    Dim SN(0 To 3) As Variant\r\n    Dim shp, i, o, p, rt\r\n    '\u539f\u70b9(0,0,0)\u3068\u306a\u308bOffice\u30a2\u30d7\u30ea\u4e0a\u306e\u5ea7\u6a19\r\n    o = Array(x, y, 0)\r\n    \r\n    '\u539f\u70b9\u304c\u91cd\u5fc3\u3067\u8fba\u306e\u9577\u30551\u306e\u7acb\u65b9\u4f53\u306e\u9802\u70b9\u306e\u914d\u5217\r\n    p = Array(Array(-1, 1, -1), _\r\n    Array(1, 1, -1), _\r\n    Array(1, 1, 1), _\r\n    Array(-1, 1, 1), _\r\n    Array(-1, -1, -1), _\r\n    Array(1, -1, -1), _\r\n    Array(1, -1, 1), _\r\n    Array(-1, -1, 1))\r\n\r\n    '\u5ea7\u6a19\u70b9\u3092r\/2\u500d\u3059\u308b\r\n    For i = 0 To UBound(p, 1)\r\n        p(i) = MatScl(p(i), r \/ 2)\r\n    Next\r\n    \r\n    '\u5168\u9802\u70b9\u3092\u56de\u8ee2\r\n    rt = Array(30, 20, -20)  'x\u8ef8\u3001y\u8ef8\u3001z\u8ef8\u306e\u56de\u8ee2\u89d2\u5ea6\r\n    For i = 0 To UBound(p, 1)\r\n        p(i) = Zrote((Yrote(Xrote(p(i), rt(0)), rt(1))), rt(2))\r\n    Next\r\n    \r\n    '\u8fba\u3092\u66f8\u3044\u3066\u3044\u304f\r\n    '\u8868\u306e\u8fba\r\n    Set shp = trackline(obj, o, p, Array(5, 4, 7, 6, 5, 1, 2, 3, 7))\r\n    Call lineattr(shp, msoLineSolid, 2)\r\n    SN(0) = shp.Name\r\n    Set shp = trackline(obj, o, p, Array(2, 6))\r\n    Call lineattr(shp, msoLineSolid, 2)\r\n    SN(1) = shp.Name\r\n    '\u88cf\u306e\u8fba\r\n    Set shp = trackline(obj, o, p, Array(3, 0, 1))\r\n    Call lineattr(shp, msoLineDash, 2)\r\n    SN(2) = shp.Name\r\n    Set shp = trackline(obj, o, p, Array(0, 4))\r\n    Call lineattr(shp, msoLineDash, 2)\r\n    SN(3) = shp.Name\r\n\r\n    '\u30b0\u30eb\u30fc\u30d7\u5316\r\n    obj.Shapes.Range(SN).Group.Name = \"\u7acb\u65b9\u4f53\"\r\n    Set Cube = shp\r\n\r\nEnd Function\r\n\r\nFunction Pyramid(obj, x, y, r)\r\n    '\u6b63\u56db\u89d2\u9310\u3092\u63cf\u753b\r\n    ' obj \u63cf\u753b\u3059\u308b\u30aa\u30d6\u30b8\u30a7\u30af\u30c8\r\n    ' \u91cd\u5fc3(x,y,0) 1\u8fba\u306e\u9577\u3055 r\r\n    \r\n    Dim SN(0 To 2) As Variant\r\n    Dim shp, i, o, p, rt\r\n    '\u539f\u70b9(0,0,0)\u3068\u306a\u308bOffice\u30a2\u30d7\u30ea\u4e0a\u306e\u5ea7\u6a19\r\n    o = Array(x, y, 0)\r\n    \r\n    '\u539f\u70b9\u304c\u91cd\u5fc3\u3067\u8fba\u306e\u9577\u30551\u306e\u6b63\u56db\u9762\u4f53\u306e\u9802\u70b9\u306e\u914d\u5217\r\n    p = Array(Array(0, -3 \/ Sqr(2) \/ 2, 0), _\r\n    Array(1, 1 \/ Sqr(2) \/ 2, 1), _\r\n    Array(-1, 1 \/ Sqr(2) \/ 2, 1), _\r\n    Array(-1, 1 \/ Sqr(2) \/ 2, -1), _\r\n    Array(1, 1 \/ Sqr(2) \/ 2, -1))\r\n\r\n    '\u5ea7\u6a19\u70b9\u3092r\/2\u500d\u3059\u308b\r\n    For i = 0 To UBound(p, 1)\r\n        p(i) = MatScl(p(i), r \/ 2)\r\n    Next\r\n\r\n    '\u5168\u9802\u70b9\u3092\u56de\u8ee2\r\n    rt = Array(10, 20, 0)  'x\u8ef8\u3001y\u8ef8\u3001z\u8ef8\u306e\u56de\u8ee2\u89d2\u5ea6\r\n    For i = 0 To UBound(p, 1)\r\n        p(i) = Zrote((Yrote(Xrote(p(i), rt(0)), rt(1))), rt(2))\r\n    Next\r\n    \r\n    '\u8fba\u3092\u66f8\u3044\u3066\u3044\u304f\r\n    '\u8868\u306e\u8fba\r\n    Set shp = trackline(obj, o, p, Array(0, 2, 1, 0, 4, 1))\r\n    Call lineattr(shp, msoLineSolid, 2)\r\n    SN(0) = shp.Name\r\n    '\u88cf\u306e\u8fba\r\n    Set shp = trackline(obj, o, p, Array(2, 3, 4))\r\n    Call lineattr(shp, msoLineDash, 2)\r\n    SN(1) = shp.Name\r\n    Set shp = trackline(obj, o, p, Array(0, 3))\r\n    Call lineattr(shp, msoLineDash, 2)\r\n    SN(2) = shp.Name\r\n\r\n    '\u30b0\u30eb\u30fc\u30d7\u5316\r\n    obj.Shapes.Range(SN).Group.Name = \"\u56db\u89d2\u9310\"\r\n    Set Pyramid = shp\r\n\r\nEnd Function\r\n\r\nFunction Tetrahedron(obj, x, y, r)\r\n    '\u6b63\u56db\u9762\u4f53\u3092\u63cf\u753b\r\n    ' obj \u63cf\u753b\u3059\u308b\u30aa\u30d6\u30b8\u30a7\u30af\u30c8\r\n    ' \u91cd\u5fc3(x,y,0) 1\u8fba\u306e\u9577\u3055 r\r\n    \r\n    Dim SN(0 To 1) As Variant\r\n    Dim shp, i, o, p, rt\r\n    '\u539f\u70b9(0,0,0)\u3068\u306a\u308bOffice\u30a2\u30d7\u30ea\u4e0a\u306e\u5ea7\u6a19\r\n    o = Array(x, y, 0)\r\n    \r\n    '\u539f\u70b9\u304c\u91cd\u5fc3\u3067\u8fba\u306e\u9577\u30551\u306e\u6b63\u56db\u9762\u4f53\u306e\u9802\u70b9\u306e\u914d\u5217\r\n    p = Array(Array(0, 0, Sqr(2) \/ Sqr(3) * (2 \/ 3)), _\r\n    Array(-1 \/ 2, 1 \/ Sqr(3) \/ 2, -Sqr(2) \/ Sqr(3) \/ 3), _\r\n    Array(1 \/ 2, 1 \/ Sqr(3) \/ 2, -Sqr(2) \/ Sqr(3) \/ 3), _\r\n    Array(0, -1 \/ Sqr(3), -Sqr(2) \/ Sqr(3) \/ 3))\r\n\r\n    '\u5ea7\u6a19\u70b9\u3092r\u500d\u3059\u308b\r\n    For i = 0 To UBound(p, 1)\r\n        p(i) = MatScl(p(i), r)\r\n    Next\r\n\r\n    '\u5168\u9802\u70b9\u3092\u56de\u8ee2\r\n    rt = Array(300, 120, -25)  'x\u8ef8\u3001y\u8ef8\u3001z\u8ef8\u306e\u56de\u8ee2\u89d2\u5ea6\r\n    For i = 0 To UBound(p, 1)\r\n        p(i) = Zrote((Yrote(Xrote(p(i), rt(0)), rt(1))), rt(2))\r\n    Next\r\n    \r\n    '\u8fba\u3092\u66f8\u3044\u3066\u3044\u304f\r\n    '\u8868\u306e\u8fba\r\n    Set shp = trackline(obj, o, p, Array(0, 1, 2, 0, 3, 1))\r\n    Call lineattr(shp, msoLineSolid, 2)\r\n    SN(0) = shp.Name\r\n\r\n    '\u88cf\u306e\u8fba\r\n    Set shp = trackline(obj, o, p, Array(2, 3))\r\n    Call lineattr(shp, msoLineDash, 2)\r\n    SN(1) = shp.Name\r\n\r\n    '\u30b0\u30eb\u30fc\u30d7\u5316\r\n    obj.Shapes.Range(SN).Group.Name = \"\u6b63\u56db\u9762\u4f53\"\r\n    Set Tetrahedron = shp\r\n\r\nEnd Function\r\n\r\nFunction trackline(obj, o, p, Route)\r\n    '\u70b9\u304b\u3089\u70b9\u3078\u306e\u7dda\u3092\u63cf\u753b\r\n    Dim shp_Name() As Variant\r\n    Dim shp, i\r\n\r\n    ReDim shp_Name(UBound(Route) - 1)\r\n    For i = 0 To UBound(Route) - 1\r\n        Set shp = obj.Shapes.AddConnector(msoConnectorStraight, o(0) + Int(p(Route(i + 1))(0)), o(1) + Int(p(Route(i + 1))(1)), o(0) + Int(p(Route(i))(0)), o(1) + Int(p(Route(i))(1)))\r\n        shp_Name(i) = shp.Name\r\n        \r\n        '\u756a\u53f7\u3092\u3075\u308b(\u30c7\u30d0\u30c3\u30af\u7528)\r\n        'Set txt = obj.Shapes.AddTextbox(msoTextOrientationHorizontal, o(0) + Int(p(Route(i + 1))(0)), o(1) + Int(p(Route(i + 1))(1)), 20, 20)\r\n        'txt.TextFrame.Characters.Text = Route(i + 1)\r\n    Next\r\n\r\n    If UBound(Route) > 1 Then\r\n        obj.Shapes.Range(shp_Name).Group.Name = shp_Name(0)\r\n        Set trackline = obj.Shapes(shp_Name(0))\r\n    Else\r\n        Set trackline = shp\r\n    End If\r\nEnd Function\r\n\r\nFunction lineattr(obj, d, Optional w As Integer = 1, Optional rgb As Long = 12287562)\r\n    '\u7dda\u306e\u30b9\u30bf\u30a4\u30eb\u3001\u592a\u3055\u3001\u8272(\u4efb\u610f)\u3092\u5909\u66f4\r\n    With obj\r\n        .Line.DashStyle = d\r\n        .Line.Weight = w\r\n        .Line.ForeColor.rgb = rgb\r\n    End With\r\nEnd Function\r\n\r\nFunction Xrote(v, d)   'v\u306f(x,y,z)\u5ea7\u6a19\u306e\u914d\u5217\u3001d\u306f\u89d2\u5ea6(0-360)\r\n    'X\u8ef8\u56de\u8ee2\u3055\u305b\u308b\r\n    '   1    0    0\r\n    '   0  cos  sin\r\n    '   0 -sin  cos\r\n    Dim rad_1do\r\n    rad_1do = 2 \/ 360 * 3.141594\r\n    Xrote = Array(v(0), Cos(d * rad_1do) * v(1) + Sin(d * rad_1do) * v(2), -Sin(d * rad_1do) * v(1) + Cos(d * rad_1do) * v(2))\r\nEnd Function\r\nFunction Yrote(v, d)   'v\u306f(x,y,z)\u5ea7\u6a19\u306e\u914d\u5217\u3001d\u306f\u89d2\u5ea6(0-360)\r\n    'Y\u8ef8\u56de\u8ee2\u3055\u305b\u308b\r\n    ' cos    0 -sin\r\n    '   0    1    0\r\n    ' sin    0  cos\r\n    Dim rad_1do\r\n    rad_1do = 2 \/ 360 * 3.141594\r\n    Yrote = Array(Cos(d * rad_1do) * v(0) - Sin(d * rad_1do) * v(2), v(1), Sin(d * rad_1do) * v(0) + Cos(d * rad_1do) * v(2))\r\nEnd Function\r\nFunction Zrote(v, d)   'v\u306f(x,y,z)\u5ea7\u6a19\u306e\u914d\u5217\u3001d\u306f\u89d2\u5ea6(0-360)\r\n    'Z\u8ef8\u56de\u8ee2\u3055\u305b\u308b\r\n    '  cos  sin   0\r\n    ' -sin  cos   0\r\n    '    0    0   1\r\n    Dim rad_1do\r\n    rad_1do = 2 \/ 360 * 3.141594\r\n    Zrote = Array(Cos(d * rad_1do) * v(0) + Sin(d * rad_1do) * v(1), -Sin(d * rad_1do) * v(0) + Cos(d * rad_1do) * v(1), v(2))\r\nEnd Function\r\n\r\nFunction MatScl(v, scl)\r\n    '(x,y,z)\u5ea7\u6a19\u306e\u914d\u5217\u306e\u8981\u7d20\u3092scl\u500d\u3059\u308b\r\n    Dim a\r\n    a = Array(v(0) * scl, v(1) * scl, v(2) * scl)\r\n    MatScl = Array(v(0) * scl, v(1) * scl, v(2) * scl)\r\nEnd Function\r\n\r\n<\/code><\/pre>\n<\/div>\n","protected":false},"excerpt":{"rendered":"<p>ExcelVBA\u3067\u6570\u5b66\u306e\u6559\u79d1\u66f8\u306b\u3042\u308b\u3088\u3046\u306a\u7acb\u4f53\u56f3\u5f62\u3092\u63cf\u3044\u3066\u307f\u305f \u3053\u306e\u52d5\u753b\u306e\u30de\u30af\u30ed\u306fWindows11 [&hellip;]<\/p>\n","protected":false},"author":1,"featured_media":2414,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"_jetpack_memberships_contains_paid_content":false,"footnotes":"","jetpack_publicize_message":"","jetpack_publicize_feature_enabled":true,"jetpack_social_post_already_shared":true,"jetpack_social_options":{"image_generator_settings":{"template":"highway","default_image_id":0,"font":"","enabled":false},"version":2}},"categories":[34],"tags":[],"class_list":["post-2412","post","type-post","status-publish","format-standard","has-post-thumbnail","hentry","category-vba"],"jetpack_publicize_connections":[],"jetpack_featured_media_url":"http:\/\/oreoreki.gotdns.ch\/wp-content\/uploads\/sites\/2\/2022\/06\/vba.jpg","jetpack_shortlink":"https:\/\/wp.me\/p9WqRX-CU","jetpack_sharing_enabled":true,"_links":{"self":[{"href":"http:\/\/oreoreki.gotdns.ch\/index.php?rest_route=\/wp\/v2\/posts\/2412","targetHints":{"allow":["GET"]}}],"collection":[{"href":"http:\/\/oreoreki.gotdns.ch\/index.php?rest_route=\/wp\/v2\/posts"}],"about":[{"href":"http:\/\/oreoreki.gotdns.ch\/index.php?rest_route=\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"http:\/\/oreoreki.gotdns.ch\/index.php?rest_route=\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"http:\/\/oreoreki.gotdns.ch\/index.php?rest_route=%2Fwp%2Fv2%2Fcomments&post=2412"}],"version-history":[{"count":1,"href":"http:\/\/oreoreki.gotdns.ch\/index.php?rest_route=\/wp\/v2\/posts\/2412\/revisions"}],"predecessor-version":[{"id":2413,"href":"http:\/\/oreoreki.gotdns.ch\/index.php?rest_route=\/wp\/v2\/posts\/2412\/revisions\/2413"}],"wp:featuredmedia":[{"embeddable":true,"href":"http:\/\/oreoreki.gotdns.ch\/index.php?rest_route=\/wp\/v2\/media\/2414"}],"wp:attachment":[{"href":"http:\/\/oreoreki.gotdns.ch\/index.php?rest_route=%2Fwp%2Fv2%2Fmedia&parent=2412"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"http:\/\/oreoreki.gotdns.ch\/index.php?rest_route=%2Fwp%2Fv2%2Fcategories&post=2412"},{"taxonomy":"post_tag","embeddable":true,"href":"http:\/\/oreoreki.gotdns.ch\/index.php?rest_route=%2Fwp%2Fv2%2Ftags&post=2412"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}