|
Sub macro20200419b()
'図形のビジュアル一覧を作成する
Dim i As Integer
Dim ary()
Dim st()
Sheets.Add 'シート追加
'オートシェイプのタイプを格納する配列stを作成
ary = Array(msoShape10pointStar, msoShape12pointStar, _
msoShape16pointStar, msoShape24pointStar, _
msoShape32pointStar, msoShape4pointStar, _
msoShape5pointStar, msoShape6pointStar, _
msoShape7pointStar, msoShape8pointStar, _
msoShapeActionButtonBackorPrevious, _
msoShapeActionButtonBeginning, _
msoShapeActionButtonCustom, _
msoShapeActionButtonDocument, _
msoShapeActionButtonEnd, _
msoShapeActionButtonForwardorNext, _
msoShapeActionButtonHelp, msoShapeActionButtonHome, _
msoShapeActionButtonInformation, _
msoShapeActionButtonMovie, _
msoShapeActionButtonReturn, _
msoShapeActionButtonSound, _
msoShapeArc, msoShapeBalloon, _
msoShapeBentArrow, msoShapeBentUpArrow, _
msoShapeBevel, msoShapeBlockArc, _
msoShapeCan, msoShapeChartPlus)
st = ary
ary = Array(msoShapeChartStar, msoShapeChartX, _
msoShapeChevron, msoShapeChord, _
msoShapeCircularArrow, msoShapeCloud, _
msoShapeCloudCallout, msoShapeCorner, _
msoShapeCornerTabs, msoShapeCross, _
msoShapeCube, msoShapeCurvedDownArrow, _
msoShapeCurvedDownRibbon, msoShapeCurvedLeftArrow, _
msoShapeCurvedRightArrow, msoShapeCurvedUpArrow, _
msoShapeCurvedUpRibbon, msoShapeDecagon, _
msoShapeDiagonalStripe, msoShapeDiamond, _
msoShapeDodecagon, msoShapeDonut, _
msoShapeDoubleBrace, msoShapeDoubleBracket, _
msoShapeDoubleWave, msoShapeDownArrow, _
msoShapeDownArrowCallout, msoShapeDownRibbon, _
msoShapeExplosion1, msoShapeExplosion2, _
msoShapeFlowchartAlternateProcess, msoShapeFlowchartCard, _
msoShapeFlowchartCollate, msoShapeFlowchartConnector, _
msoShapeFlowchartData, msoShapeFlowchartDecision, _
msoShapeFlowchartDelay, msoShapeFlowchartDirectAccessStorage, _
msoShapeFlowchartDisplay, msoShapeFlowchartDocument)
For i = 1 To UBound(ary)
ReDim Preserve st(UBound(st) + 1)
st(UBound(st)) = ary(i)
Next i
ary = Array(msoShapeFlowchartExtract, _
msoShapeFlowchartInternalStorage, _
msoShapeFlowchartMagneticDisk, msoShapeFlowchartManualInput, _
msoShapeFlowchartManualOperation, msoShapeFlowchartMerge, _
msoShapeFlowchartMultidocument, _
msoShapeFlowchartOfflineStorage, _
msoShapeFlowchartOffpageConnector, msoShapeFlowchartOr, _
msoShapeFlowchartPredefinedProcess, _
msoShapeFlowchartPreparation, _
msoShapeFlowchartProcess, msoShapeFlowchartPunchedTape, _
msoShapeFlowchartSort, _
msoShapeFlowchartStoredData, _
msoShapeFlowchartSummingJunction, _
msoShapeFlowchartTerminator, msoShapeFoldedCorner, _
msoShapeFrame, msoShapeFunnel, _
msoShapeGear6, msoShapeGear9, _
msoShapeHalfFrame, msoShapeHeart, _
msoShapeHeptagon, msoShapeHexagon, _
msoShapeHorizontalScroll, msoShapeIsoscelesTriangle)
' msoShapeFlowchartSequentialAcessStorage, _
For i = 1 To UBound(ary)
ReDim Preserve st(UBound(st) + 1)
st(UBound(st)) = ary(i)
Next i
ary = Array(msoShapeLeftArrow, msoShapeLeftArrowCallout, _
msoShapeLeftBrace, msoShapeLeftBracket, _
msoShapeLeftCircularArrow, msoShapeLeftRightArrow, _
msoShapeLeftRightArrowCallout, _
msoShapeLeftRightCircularArrow, _
msoShapeLeftRightRibbon, msoShapeLeftRightUpArrow, _
msoShapeLeftUpArrow, msoShapeLightningBolt, _
msoShapeLineCallout1, msoShapeLineCallout1AccentBar, _
msoShapeLineCallout1BorderandAccentBar, _
msoShapeLineCallout1NoBorder, _
msoShapeLineCallout2, msoShapeLineCallout2AccentBar, _
msoShapeLineCallout2BorderandAccentBar, _
msoShapeLineCallout2NoBorder, _
msoShapeLineCallout3, msoShapeLineCallout3AccentBar, _
msoShapeLineCallout3BorderandAccentBar, _
msoShapeLineCallout3NoBorder, _
msoShapeLineCallout4, msoShapeLineCallout4AccentBar, _
msoShapeLineCallout4BorderandAccentBar, _
msoShapeLineCallout4NoBorder, _
msoShapeLineInverse, msoShapeMathDivide)
For i = 1 To UBound(ary)
ReDim Preserve st(UBound(st) + 1)
st(UBound(st)) = ary(i)
Next i
ary = Array(msoShapeMathEqual, msoShapeMathMinus, _
msoShapeMathMultiply, msoShapeMathNotEqual, _
msoShapeMathPlus, msoShapeMixed, _
msoShapeMoon, msoShapeNonIsoscelesTrapezoid, _
msoShapeNoSymbol, msoShapeNotchedRightArrow, _
msoShapeNotPrimitive, msoShapeOctagon, _
msoShapeOval, msoShapeOvalCallout, _
msoShapeParallelogram, msoShapePentagon, _
msoShapePie, msoShapePieWedge, _
msoShapePlaque, msoShapePlaqueTabs, _
msoShapeQuadArrow, msoShapeQuadArrowCallout, _
msoShapeRectangle, msoShapeRectangularCallout, _
msoShapeRegularPentagon, msoShapeRightArrow, _
msoShapeRightArrowCallout, msoShapeRightBrace, _
msoShapeRightBracket, msoShapeRightTriangle, _
msoShapeRound1Rectangle, msoShapeRound2DiagRectangle, _
msoShapeRound2SameRectangle, msoShapeRoundedRectangle, _
msoShapeRoundedRectangularCallout, msoShapeSmileyFace, _
msoShapeSnip1Rectangle, msoShapeSnip2DiagRectangle, _
msoShapeSnip2SameRectangle, msoShapeSnipRoundRectangle)
For i = 1 To UBound(ary)
ReDim Preserve st(UBound(st) + 1)
st(UBound(st)) = ary(i)
Next i
ary = Array(msoShapeSquareTabs, msoShapeStripedRightArrow, _
msoShapeSun, msoShapeSwooshArrow, _
msoShapeTear, msoShapeTrapezoid, _
msoShapeUpArrow, msoShapeUpArrowCallout, _
msoShapeUpDownArrow, msoShapeUpDownArrowCallout, _
msoShapeUpRibbon, msoShapeUTurnArrow, _
msoShapeVerticalScroll, msoShapeWave)
For i = 1 To UBound(ary)
ReDim Preserve st(UBound(st) + 1)
st(UBound(st)) = ary(i)
Next i
'オートシェイプのタイプを格納する配列stを作成 終了
'シェイプを作成
For i = 1 To UBound(st)
'各種シェイプ作成
On Error Resume Next
ActiveSheet.Shapes.AddShape( _
st(i), 30 + (i Mod 10) * 100, _
10 + Int(i / 10) * 100, _
70, 50).Select
On Error GoTo 0
'文字表示用四角形の作成
ActiveSheet.Shapes.AddShape( _
msoShapeRectangle, 30 + (i Mod 10) * 100, _
10 + Int(i / 10) * 100, _
70, 50).Select
Selection.Text = i & Chr(10) & "type: " & st(i)
With Selection.ShapeRange
.Fill.Visible = msoFalse
.Line.Visible = msoFalse
.TextFrame2.VerticalAnchor = msoAnchorMiddle
End With
With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
.Solid
End With
Next i
End Sub
|
