#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 '最背面に移動

トップ   編集 差分 履歴 添付 複製 名前変更 リロード   新規 一覧 検索 最終更新   ヘルプ   最終更新のRSS