bxdxmx3

きじれてじろあ なきがせすで あぷせとねでぶ

Excel:図形作成マクロ

Sub □を作る()
    Shapeを作る (msoShapeRectangle)
End Sub

Sub DBを作る()
    Shapeを作る (msoShapeCan)
End Sub

Sub 帳票を作る()
    Shapeを作る (msoShapeFlowchartDocument)
End Sub


Private Sub Shapeを作る(shapeKind As Long)
    Dim activeCellText As String
    activeCellText = ActiveCell.Text
    ActiveCell.Value = ""

    Dim oShape As Shape
    Set oShape = ActiveSheet.Shapes.AddShape(shapeKind, ActiveCell.Left, ActiveCell.Top, 100, 50)

    oShape.ShapeStyle = msoShapeStylePreset1
    oShape.TextFrame2.TextRange.Characters.Text = activeCellText

    With oShape.TextFrame2.TextRange.Characters
        With .ParagraphFormat
            .FirstLineIndent = 0
            .Alignment = msoAlignLeft
        End With

        With .Font
            .NameComplexScript = "+mn-cs"
            .NameFarEast = "+mn-ea"
            .Fill.Visible = msoTrue
            .Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
            .Fill.ForeColor.TintAndShade = 0
            .Fill.ForeColor.Brightness = 0
            .Fill.Transparency = 0
            .Fill.Solid
            .Size = 11
            .name = "+mn-lt"
        End With
    End With

    oShape.Line.Weight = 1

    With oShape.TextFrame2
        .VerticalAnchor = msoAnchorMiddle
        .HorizontalAnchor = msoAnchorCenter
    End With

End Sub