|
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
|
コメント