https://ameblo.jp/werthersan/ ブログの説明を入力します。 ja Sub getRectangle()
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 300, 100, 70, 35).Select
    With Selection.ShapeRange
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .Line.Visible = msoTrue
        .Line.ForeColor.ObjectThemeColor = msoThemeColorText1
        .Line.Weight = 1.5
    End With
    With Selection.ShapeRange.TextFrame2
        With .TextRange.Font.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 0, 0)
            .Transparency = 0
            .Solid
        End With
        .VerticalAnchor = msoAnchorMiddle
        .TextRange.ParagraphFormat.Alignment = msoAlignCenter
        .TextRange.Characters.Text = "プロセス"
        Selection.ShapeRange.ScaleWidth 1.2, msoFalse, msoScaleFromTopLeft
        Selection.ShapeRange.ScaleHeight 1.2, msoFalse, msoScaleFromTopLeft
    End With
End Sub
Sub getroundedrectangle()
    ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 300, 100, 70, 35).Select
    With Selection.ShapeRange
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .Line.Visible = msoTrue
        .Line.ForeColor.ObjectThemeColor = msoThemeColorText1
        .Line.Weight = 1.5
    End With
    With Selection.ShapeRange.TextFrame2
        With .TextRange.Font.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 0, 0)
            .Transparency = 0
            .Solid
        End With
        .VerticalAnchor = msoAnchorMiddle
        .TextRange.ParagraphFormat.Alignment = msoAlignCenter
        .TextRange.Characters.Text = "開始/終了"
        Selection.ShapeRange.ScaleWidth 1.2, msoFalse, msoScaleFromTopLeft
        Selection.ShapeRange.ScaleHeight 1.2, msoFalse, msoScaleFromTopLeft
    End With
End Sub
Sub getdocument()
    ActiveSheet.Shapes.AddShape(msoShapeFlowchartCard, 300, 100, 70, 35).Select
    With Selection.ShapeRange
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .Line.Visible = msoTrue
        .Line.ForeColor.ObjectThemeColor = msoThemeColorText1
        .Line.Weight = 1.5
    End With
    With Selection.ShapeRange.TextFrame2
        With .TextRange.Font.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 0, 0)
            .Transparency = 0
            .Solid
        End With
        .VerticalAnchor = msoAnchorMiddle
        .TextRange.ParagraphFormat.Alignment = msoAlignCenter
        .TextRange.Characters.Text = "書類"
        Selection.ShapeRange.ScaleWidth 1.2, msoFalse, msoScaleFromTopLeft
        Selection.ShapeRange.ScaleHeight 1.2, msoFalse, msoScaleFromTopLeft
    End With
End Sub
Sub getarea()
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 150, 40, 300, 425).Select
    With Selection.ShapeRange
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .Line.Visible = msoTrue
        .Line.ForeColor.ObjectThemeColor = msoThemeColorText1
        .Line.Weight = 1.5
    End With
    With Selection.ShapeRange.TextFrame2
        With .TextRange.Font.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 0, 0)
            .Transparency = 0
            .Solid
        End With
        .VerticalAnchor = msoAnchorTop
        .TextRange.ParagraphFormat.Alignment = msoAlignCenter
        .TextRange.Characters.Text = "枠"
        Selection.ShapeRange.ScaleWidth 1.2, msoFalse, msoScaleFromTopLeft
        Selection.ShapeRange.ScaleHeight 1.2, msoFalse, msoScaleFromTopLeft
    End With

End Sub
Sub getdecision()
    ActiveSheet.Shapes.AddShape(msoShapeFlowchartDecision, 300, 100, 70, 35).Select
    With Selection.ShapeRange
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .Line.Visible = msoTrue
        .Line.ForeColor.ObjectThemeColor = msoThemeColorText1
        .Line.Weight = 1.5
    End With
    With Selection.ShapeRange.TextFrame2
        With .TextRange.Font.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 0, 0)
            .Transparency = 0
            .Solid
        End With
        .VerticalAnchor = msoAnchorMiddle
        .TextRange.ParagraphFormat.Alignment = msoAlignCenter
        .TextRange.Characters.Text = "判断/分岐"
        Selection.ShapeRange.ScaleWidth 1.2, msoFalse, msoScaleFromTopLeft
        Selection.ShapeRange.ScaleHeight 1.2, msoFalse, msoScaleFromTopLeft
    End With


End Sub
Sub gettext()
    ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, 500, 330, 70, 70).Select
    With Selection.ShapeRange.TextFrame2
        .TextRange.Characters.Text = "テキスト"
        .TextRange.ParagraphFormat.Alignment = msoAlignCenter
    End With
End Sub
Sub straightarrow()
    ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 215.25, 216, 326.25, 216.75).Select
    
    With Selection.ShapeRange
        .Line.EndArrowheadStyle = msoArrowheadTriangle
        .Height = 0
        .Width = 120
        .ShapeStyle = msoLineStylePreset1
        .Line.Weight = 1.5
    End With
    

End Sub
Sub elbowarrow()
    ActiveSheet.Shapes.AddConnector(msoConnectorElbow, 300, 250, 300, 250).Select
    Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
    Selection.ShapeRange.ShapeStyle = msoLineStylePreset1
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .Weight = 1.5
    End With
    
    Selection.ShapeRange.Height = 30
    Selection.ShapeRange.Width = 120
End Sub
Sub getcircle()
    ActiveSheet.Shapes.AddShape(msoShapeOval, 250, 80, 100, 35).Select
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .Transparency = 0
    End With
    Selection.ShapeRange.Fill.Visible = msoFalse

End Sub
Sub getCRTformat()
    Range("D4").Select
    Sheets("1雛形").DrawingObjects.Copy
    Sheets("フローチャート").Paste
End Sub

 

]]> https://ameblo.jp/werthersan/entry-12521176353.html Thu, 05 Sep 2019 22:26:42 +0900