Sibainu Relax Room

愛犬の柴犬とともに過ごす部屋

EXCELLでSHAPEを扱う1

SHAPEに文字を入れる

シェイプに文字を入れる方法

copy

Private Sub CommandButton1_Click()
    Dim myDocument As Object
    Dim Sp As Shape

    Set myDocument = Worksheets(1)

    For Each Sp In myDocument.Shapes
        If Sp.Name = "車検点検ID" Then
            Sp.Delete
        End If
    Next Sp

    With myDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, _
                                      ActiveCell.Offset(0, 1).Left, _
                                      ActiveCell.Offset(0, 1).Top, _
                                      200, _
                                      50)
        .Name = "適宜"
        With .TextFrame.Characters
            .Text = "Test Box"
            .Font.Size = 8
        End With
    End With

    'AddShapeを使う方法、細部に設定できますが複雑になります。
    With myDocument.Shapes.AddShape(msoShapeRectangle, _  
                                  ActiveCell.Offset(0, 1).Left, _
                                    ActiveCell.Offset(0, 1).Top, _
                                    200, _
                                    50)


        .Name = "適宜"
        .Fill.ForeColor.RGB = RGB(255, 255, 255) 'デフォルトは青色で塗りつぶされています。
        With .Line
            .ForeColor.RGB = RGB(0, 0, 0) '枠線の色
            .Weight = 0.5 '太さ
            .Style = msoLineSingle '線のスタイル
            .DashStyle = msoLineSolid '線のタイプ
        End With

        With .TextFrame2
            .MarginTop = 20
            .MarginRight = 10
            .MarginBottom = 20
            .MarginLeft = 10
            With .TextRange
                .Text = "Here is some test text"
                With .Font
                    .Size = 11
                    .Name = "MS P明朝"
                    .Bold = True
                    .Fill.ForeColor.RGB = RGB(0, 0, 0)
                End With
            End With
        End With
        
    End With
    
End Sub