#author("2024-12-01T11:08:55+09:00","default:irrp","irrp") #author("2024-12-01T11:09:05+09:00","default:irrp","irrp") →[[ExcelのVBA]] #contents *記事 [#b5416b58] -[[図形の入った資料を高速で書く試み #Excel - Qiita>https://qiita.com/pbk-sato/items/6d5cf1aca79b542866c8]] 2023.11 -[[Excel VBA(マクロ)で図形の位置を取得・変更・移動する方法/Top、Left、IncrementLeft、IncrementTopの使い方 | すなぎつ>https://sunagitsune.com/excelvbashapestopleft/]] 2022.3 *サンプル [#hcc93d9d] -角丸のボックスにする shp.AutoShapeType = msoShapeRoundedRectangle '角丸 -シェイプの間をコネクタでつなぐ例 2024.12 Dim fromshp as Shape set fromshp = sht.Shapes.AddShape(msoShapeRectangle, left1, top2, boxW, boxH) Dim toshp as Shape set toshp = sht.Shapes.AddShape(msoShapeRectangle, left2, top2, boxW, boxH) 'コネクタ生成 Dim con As Shape Set con = sht.Shapes.AddConnector(conType, 0, 0, 0, 0) '矢印 con.Line.EndArrowheadStyle = msoArrowheadTriangle '黒線にする con.Line.ForeColor.RGB = RGB(0, 0, 0) ' from con.ConnectorFormat.BeginConnect fromshp, 4 ' to con.ConnectorFormat.EndConnect toshp, 2 --セルの座標は Range("X1").Left/Top で取れる -シート上のシェイプの色をまとめて黒に戻す例 [#d19b3958] Sub Macro1() Dim i As Integer Dim acs As Worksheet Set acs = ActiveSheet For i = 1 To acs.Shapes.Count Dim shap As Shape Set shap = acs.Shapes(i) With shap acs.Activate shap.Select DoEvents If (shap.Type = msoAutoShape) Then If shap.AutoShapeType = msoShapeMixed Then 'コンピュータ図とか ElseIf shap.AutoShapeType = msoShapeRoundedRectangle Then '角の丸い四角 Selection.Font.ColorIndex = xlAutomatic End If ElseIf shap.Type = msoLine Then Selection.ShapeRange.Line.ForeColor.SchemeColor = 64 Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255) ElseIf shap.Type = msoTextBox Then Selection.Font.ColorIndex = xlAutomatic End If End With Next End Sub -シェイプを最背面に移動 [#t09962c5] Selection.ShapeRange.ZOrder msoSendToBack '最背面に移動