Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


1569 / 13645 ツリー ←次へ | 前へ→

【73471】オートシェイプのプロパティの種類と値をセルに書き出す すが分 13/1/14(月) 10:33 質問[未読]
【73472】Re:オートシェイプのプロパティの種類と値... カリーニン 13/1/14(月) 11:26 発言[未読]
【73473】Re:オートシェイプのプロパティの種類と値... カリーニン 13/1/14(月) 11:38 発言[未読]
【73474】Re:オートシェイプのプロパティの種類と値... すが分 13/1/14(月) 14:44 質問[未読]
【73475】Re:オートシェイプのプロパティの種類と値... カリーニン 13/1/14(月) 15:13 発言[未読]
【73478】Re:オートシェイプのプロパティの種類と値... UO3 13/1/14(月) 20:13 発言[未読]
【73479】Re:オートシェイプのプロパティの種類と値... UO3 13/1/14(月) 20:55 発言[未読]
【73481】Re:オートシェイプのプロパティの種類と値... すが分 13/1/14(月) 22:15 お礼[未読]

【73471】オートシェイプのプロパティの種類と値を...
質問  すが分  - 13/1/14(月) 10:33 -

引用なし
パスワード
   オートシェイプにいろいろな種類があり、いろいろな絵柄に関するプロパティがあります。
いちいちヘルプでどんな種類があるか調べるのが大変なので、プロパティの種類と値をセルに書き出すマクロを作ってみたいです。
そういうコードを思いつかないのですが、よい方法はないでしょうか。

【73472】Re:オートシェイプのプロパティの種類と...
発言  カリーニン  - 13/1/14(月) 11:26 -

引用なし
パスワード
   普通にシェイプのAutoShapeTypeを取得すると数値になりますので
Dictionaryを使ってAutoShapeTypeを文字列に変換しました。

アクティブシートの全シェイプの名前、種類、Left、Top、Width、Height
を取得するサンプルです。

回転させているシェイプの回転角度や調整ハンドルでの調整値の取得方法
は分かりません。

新規シートにシェイプの適当に配置してお試し下さい。

Sub test()
Dim spdic As Object
Dim sp As Object
Dim cnt As Integer
 Set spdic = CreateObject("Scripting.Dictionary")
 spdic.Add msoShapeMixed, "msoShapeMixed"
 spdic.Add msoShapeRectangle, "msoShapeRectangle"
 spdic.Add msoShapeParallelogram, "msoShapeParallelogram"
 spdic.Add msoShapeTrapezoid, "msoShapeTrapezoid"
 spdic.Add msoShapeDiamond, "msoShapeDiamond"
 spdic.Add msoShapeRoundedRectangle, "msoShapeRoundedRectangle"
 spdic.Add msoShapeOctagon, "msoShapeOctagon"
 spdic.Add msoShapeIsoscelesTriangle, "msoShapeIsoscelesTriangle"
 spdic.Add msoShapeRightTriangle, "msoShapeRightTriangle"
 spdic.Add msoShapeOval, "msoShapeOval"
 spdic.Add msoShapeHexagon, "msoShapeHexagon"
 spdic.Add msoShapeCross, "msoShapeCross"
 spdic.Add msoShapeRegularPentagon, "msoShapeRegularPentagon"
 spdic.Add msoShapeCan, "msoShapeCan"
 spdic.Add msoShapeCube, "msoShapeCube"
 spdic.Add msoShapeBevel, "msoShapeBevel"
 spdic.Add msoShapeFoldedCorner, "msoShapeFoldedCorner"
 spdic.Add msoShapeSmileyFace, "msoShapeSmileyFace"
 spdic.Add msoShapeDonut, "msoShapeDonut"
 spdic.Add msoShapeNoSymbol, "msoShapeNoSymbol"
 spdic.Add msoShapeBlockArc, "msoShapeBlockArc"
 spdic.Add msoShapeHeart, "msoShapeHeart"
 spdic.Add msoShapeLightningBolt, "msoShapeLightningBolt"
 spdic.Add msoShapeSun, "msoShapeSun"
 spdic.Add msoShapeMoon, "msoShapeMoon"
 spdic.Add msoShapeArc, "msoShapeArc"
 spdic.Add msoShapeDoubleBracket, "msoShapeDoubleBracket"
 spdic.Add msoShapeDoubleBrace, "msoShapeDoubleBrace"
 spdic.Add msoShapePlaque, "msoShapePlaque"
 spdic.Add msoShapeLeftBracket, "msoShapeLeftBracket"
 spdic.Add msoShapeRightBracket, "msoShapeRightBracket"
 spdic.Add msoShapeLeftBrace, "msoShapeLeftBrace"
 spdic.Add msoShapeRightBrace, "msoShapeRightBrace"
 spdic.Add msoShapeRightArrow, "msoShapeRightArrow"
 spdic.Add msoShapeLeftArrow, "msoShapeLeftArrow"
 spdic.Add msoShapeUpArrow, "msoShapeUpArrow"
 spdic.Add msoShapeDownArrow, "msoShapeDownArrow"
 spdic.Add msoShapeLeftRightArrow, "msoShapeLeftRightArrow"
 spdic.Add msoShapeUpDownArrow, "msoShapeUpDownArrow"
 spdic.Add msoShapeQuadArrow, "msoShapeQuadArrow"
 spdic.Add msoShapeLeftRightUpArrow, "msoShapeLeftRightUpArrow"
 spdic.Add msoShapeBentArrow, "msoShapeBentArrow"
 spdic.Add msoShapeUTurnArrow, "msoShapeUTurnArrow"
 spdic.Add msoShapeLeftUpArrow, "msoShapeLeftUpArrow"
 spdic.Add msoShapeBentUpArrow, "msoShapeBentUpArrow"
 spdic.Add msoShapeCurvedRightArrow, "msoShapeCurvedRightArrow"
 spdic.Add msoShapeCurvedLeftArrow, "msoShapeCurvedLeftArrow"
 spdic.Add msoShapeCurvedUpArrow, "msoShapeCurvedUpArrow"
 spdic.Add msoShapeCurvedDownArrow, "msoShapeCurvedDownArrow"
 spdic.Add msoShapeStripedRightArrow, "msoShapeStripedRightArrow"
 spdic.Add msoShapeNotchedRightArrow, "msoShapeNotchedRightArrow"
 spdic.Add msoShapePentagon, "msoShapePentagon"
 spdic.Add msoShapeChevron, "msoShapeChevron"
 spdic.Add msoShapeRightArrowCallout, "msoShapeRightArrowCallout"
 spdic.Add msoShapeLeftArrowCallout, "msoShapeLeftArrowCallout"
 spdic.Add msoShapeUpArrowCallout, "msoShapeUpArrowCallout"
 spdic.Add msoShapeDownArrowCallout, "msoShapeDownArrowCallout"
 spdic.Add msoShapeLeftRightArrowCallout, "msoShapeLeftRightArrowCallout"
 spdic.Add msoShapeUpDownArrowCallout, "msoShapeUpDownArrowCallout"
 spdic.Add msoShapeQuadArrowCallout, "msoShapeQuadArrowCallout"
 spdic.Add msoShapeCircularArrow, "msoShapeCircularArrow"
 spdic.Add msoShapeFlowchartProcess, "msoShapeFlowchartProcess"
 spdic.Add msoShapeFlowchartAlternateProcess, "msoShapeFlowchartAlternateProcess"
 spdic.Add msoShapeFlowchartDecision, "msoShapeFlowchartDecision"
 spdic.Add msoShapeFlowchartData, "msoShapeFlowchartData"
 spdic.Add msoShapeFlowchartPredefinedProcess, "msoShapeFlowchartPredefinedProcess"
 spdic.Add msoShapeFlowchartInternalStorage, "msoShapeFlowchartInternalStorage"
 spdic.Add msoShapeFlowchartDocument, "msoShapeFlowchartDocument"
 spdic.Add msoShapeFlowchartMultidocument, "msoShapeFlowchartMultidocument"
 spdic.Add msoShapeFlowchartTerminator, "msoShapeFlowchartTerminator"
 spdic.Add msoShapeFlowchartPreparation, "msoShapeFlowchartPreparation"
 spdic.Add msoShapeFlowchartManualInput, "msoShapeFlowchartManualInput"
 spdic.Add msoShapeFlowchartManualOperation, "msoShapeFlowchartManualOperation"
 spdic.Add msoShapeFlowchartConnector, "msoShapeFlowchartConnector"
 spdic.Add msoShapeFlowchartOffpageConnector, "msoShapeFlowchartOffpageConnector"
 spdic.Add msoShapeFlowchartCard, "msoShapeFlowchartCard"
 spdic.Add msoShapeFlowchartPunchedTape, "msoShapeFlowchartPunchedTape"
 spdic.Add msoShapeFlowchartSummingJunction, "msoShapeFlowchartSummingJunction"
 spdic.Add msoShapeFlowchartOr, "msoShapeFlowchartOr"
 spdic.Add msoShapeFlowchartCollate, "msoShapeFlowchartCollate"
 spdic.Add msoShapeFlowchartSort, "msoShapeFlowchartSort"
 spdic.Add msoShapeFlowchartExtract, "msoShapeFlowchartExtract"
 spdic.Add msoShapeFlowchartMerge, "msoShapeFlowchartMerge"
 spdic.Add msoShapeFlowchartStoredData, "msoShapeFlowchartStoredData"
 spdic.Add msoShapeFlowchartDelay, "msoShapeFlowchartDelay"
 spdic.Add msoShapeFlowchartSequentialAccessStorage, "msoShapeFlowchartSequentialAccessStorage"
 spdic.Add msoShapeFlowchartMagneticDisk, "msoShapeFlowchartMagneticDisk"
 spdic.Add msoShapeFlowchartDirectAccessStorage, "msoShapeFlowchartDirectAccessStorage"
 spdic.Add msoShapeFlowchartDisplay, "msoShapeFlowchartDisplay"
 spdic.Add msoShapeExplosion1, "msoShapeExplosion1"
 spdic.Add msoShapeExplosion2, "msoShapeExplosion2"
 spdic.Add msoShape4pointStar, "msoShape4pointStar"
 spdic.Add msoShape5pointStar, "msoShape5pointStar"
 spdic.Add msoShape8pointStar, "msoShape8pointStar"
 spdic.Add msoShape16pointStar, "msoShape16pointStar"
 spdic.Add msoShape24pointStar, "msoShape24pointStar"
 spdic.Add msoShape32pointStar, "msoShape32pointStar"
 spdic.Add msoShapeUpRibbon, "msoShapeUpRibbon"
 spdic.Add msoShapeDownRibbon, "msoShapeDownRibbon"
 spdic.Add msoShapeCurvedUpRibbon, "msoShapeCurvedUpRibbon"
 spdic.Add msoShapeCurvedDownRibbon, "msoShapeCurvedDownRibbon"
 spdic.Add msoShapeVerticalScroll, "msoShapeVerticalScroll"
 spdic.Add msoShapeHorizontalScroll, "msoShapeHorizontalScroll"
 spdic.Add msoShapeWave, "msoShapeWave"
 spdic.Add msoShapeDoubleWave, "msoShapeDoubleWave"
 spdic.Add msoShapeRectangularCallout, "msoShapeRectangularCallout"
 spdic.Add msoShapeRoundedRectangularCallout, "msoShapeRoundedRectangularCallout"
 spdic.Add msoShapeOvalCallout, "msoShapeOvalCallout"
 spdic.Add msoShapeCloudCallout, "msoShapeCloudCallout"
 spdic.Add msoShapeLineCallout1, "msoShapeLineCallout1"
 spdic.Add msoShapeLineCallout2, "msoShapeLineCallout2"
 spdic.Add msoShapeLineCallout3, "msoShapeLineCallout3"
 spdic.Add msoShapeLineCallout4, "msoShapeLineCallout4"
 spdic.Add msoShapeLineCallout1AccentBar, "msoShapeLineCallout1AccentBar"
 spdic.Add msoShapeLineCallout2AccentBar, "msoShapeLineCallout2AccentBar"
 spdic.Add msoShapeLineCallout3AccentBar, "msoShapeLineCallout3AccentBar"
 spdic.Add msoShapeLineCallout4AccentBar, "msoShapeLineCallout4AccentBar"
 spdic.Add msoShapeLineCallout1NoBorder, "msoShapeLineCallout1NoBorder"
 spdic.Add msoShapeLineCallout2NoBorder, "msoShapeLineCallout2NoBorder"
 spdic.Add msoShapeLineCallout3NoBorder, "msoShapeLineCallout3NoBorder"
 spdic.Add msoShapeLineCallout4NoBorder, "msoShapeLineCallout4NoBorder"
 spdic.Add msoShapeLineCallout1BorderandAccentBar, "msoShapeLineCallout1BorderandAccentBar"
 spdic.Add msoShapeLineCallout2BorderandAccentBar, "msoShapeLineCallout2BorderandAccentBar"
 spdic.Add msoShapeLineCallout3BorderandAccentBar, "msoShapeLineCallout3BorderandAccentBar"
 spdic.Add msoShapeLineCallout4BorderandAccentBar, "msoShapeLineCallout4BorderandAccentBar"
 spdic.Add msoShapeActionButtonCustom, "msoShapeActionButtonCustom"
 spdic.Add msoShapeActionButtonHome, "msoShapeActionButtonHome"
 spdic.Add msoShapeActionButtonHelp, "msoShapeActionButtonHelp"
 spdic.Add msoShapeActionButtonInformation, "msoShapeActionButtonInformation"
 spdic.Add msoShapeActionButtonBackorPrevious, "msoShapeActionButtonBackorPrevious"
 spdic.Add msoShapeActionButtonForwardorNext, "msoShapeActionButtonForwardorNext"
 spdic.Add msoShapeActionButtonBeginning, "msoShapeActionButtonBeginning"
 spdic.Add msoShapeActionButtonEnd, "msoShapeActionButtonEnd"
 spdic.Add msoShapeActionButtonReturn, "msoShapeActionButtonReturn"
 spdic.Add msoShapeActionButtonDocument, "msoShapeActionButtonDocument"
 spdic.Add msoShapeActionButtonSound, "msoShapeActionButtonSound"
 spdic.Add msoShapeActionButtonMovie, "msoShapeActionButtonMovie"
 spdic.Add msoShapeBalloon, "msoShapeBalloon"
 spdic.Add msoShapeNotPrimitive, "msoShapeNotPrimitive"
 cnt = 1
 ActiveSheet.Cells(1, 1).Value = "名前"
 ActiveSheet.Cells(1, 2).Value = "種類"
 ActiveSheet.Cells(1, 3).Value = "Left"
 ActiveSheet.Cells(1, 4).Value = "Top"
 ActiveSheet.Cells(1, 5).Value = "Width"
 ActiveSheet.Cells(1, 6).Value = "Height"
 For Each sp In ActiveSheet.DrawingObjects
  cnt = cnt + 1
  With ActiveSheet.Cells(cnt, 1)
  .Value = sp.Name
  .Offset(, 1).Value = spdic(ActiveSheet.Shapes(sp.Name).AutoShapeType)
  .Offset(, 2).Value = sp.Left
  .Offset(, 3).Value = sp.Top
  .Offset(, 4).Value = sp.Width
  .Offset(, 5).Value = sp.Height
  End With
 Next sp
 spdic.RemoveAll
 Set spdic = Nothing
End Sub

【73473】Re:オートシェイプのプロパティの種類と...
発言  カリーニン  - 13/1/14(月) 11:38 -

引用なし
パスワード
   先ほどのコードはエクセル2002で試しています。
2002の後に追加されたシェイプには対応してませんので
適宜シェイプの種類を追加する(Dictionaryに追加)する
必要があります。

【73474】Re:オートシェイプのプロパティの種類と...
質問  すが分  - 13/1/14(月) 14:44 -

引用なし
パスワード
   ▼カリーニン さん:
回答ありがとうございますなのですが、オートシェイプによって持っているプロパティの種類はいろいろあるようです。
大きさのほかに、色だったり、制御点(曲線などにあります)だったり、アークだったら角度だったり、です。
そういうのを、オートシェイプを選択しただけでササッと書き出せないかなと思っての質問でした。
たとえば、オートシェイプを選択しておいて、次のようなコードをイメージしていました。
set s = selecton
for i=1 to 1000000
for each p in s
 cells(i,1)=p.hogehoge
next
next
オートシェイプのクラスやプロパティを自動的にpやhogehogeに代入するのを芋づる式に引き出したいという感じですが、その方法がわかっておりません。
そのあたりの作法が知りたいです。

【73475】Re:オートシェイプのプロパティの種類と...
発言  カリーニン  - 13/1/14(月) 15:13 -

引用なし
パスワード
   >大きさのほかに、色だったり、制御点(曲線などにあります)だったり、アークだったら角度だっ>たり、です。


ですから、

>回転させているシェイプの回転角度や調整ハンドルでの調整値の取得方法
>は分かりません。

とお書きした通りです。
識者のレスをお待ち下さい。

【73478】Re:オートシェイプのプロパティの種類と...
発言  UO3  - 13/1/14(月) 20:13 -

引用なし
パスワード
   ▼すが分 さん:

こんばんは
私も、シェープの種類、階層、それぞれの階層でのプロパティ。
こんなものを網羅して説明しているページがないかという質問をしたことがあります。
また、ざっと一覧で表示できる手法がないかと調査したこともありました。

でも、その時いただいた回答では、「そんなものはない」ということでしたし
その後、シェープに関する処理を自分でおこなうにつけ、「これは無理だなぁ」と
実感しました。

超エキスパートさんなら、あるいは、そのようなオブジェクト階層を、VBAで
網羅的に取り出す手法もご存じかもしれませんが。

で、私がやった方法は、実に原始的なもので、シートに、自分が知っているシェープを
すべて配置。で、それらを

Sub Test()
  Dim sp As Shape
  
  For Each sp In ActiveSheet.Shapes
  Next
  
End Sub

こんなコードを書いて、ローカルウィンドを表示させた状態でステップ実行。
Nextが黄色くなるたびに、ローカルウィンドウの SP の階層をかたっぱしから開いて
どの階層に、どんなオブジェクト・プロパティがあるか、プロパティの場合、その値は
何か、そんなことをメモしてリファレンスにしました。

もし、どのシェープも同じオブジェクト・プロパティを持っているなら、お望みのようなコードで
情報を取得することもできるでしょうが、シェープによって、そもそもが、どんなものを
内包しているのかが、まちまちですので。


今でもしょっちゅうこのリファレンスを参照しますが、それでも、だんだん、リファレンスを
いちいち見なくても、頭に入ったものも多くなってきています。

【73479】Re:オートシェイプのプロパティの種類と...
発言  UO3  - 13/1/14(月) 20:55 -

引用なし
パスワード
   ▼すが分 さん:

こんばんは

その昔、上で申し上げたようなことで、ある程度シェープの階層を把握した時に
その理解が正しいかどうかを確かめるコードを書いたことがあります。

Sheet1 に 思いつくシェープ配置。テキストやキャプションがセットできるものについては
それらもセット。
(図や図形、フォームツールコントロールやコントロールツールボックスのコントロール、
 さらには 入力規則 の▼ 等々)

これらシェープをSheet2にリストアップします。
2003時代に作ったものですから当然2007以降にでてきたものは対象外です。

なお、別のシートに以下のそれぞれ2列のテーブルを記述しておいて、それら領域に
"msoList" と "FCList" という名前をつけておきます。

「msoList」

1    msoAutoShape
2    msoCallout
3    msoChart
4    msoComment
5    msoFreeform
6    msoGroup
7    msoEmbeddedOLEObject
8    msoFormControl
9    msoLine
10    msoLinkedOLEObject
11    msoLinkedPicture
12    msoOLEControlObject
13    msoPicture
14    msoPlaceholder
15    msoTextEffect
16    msoMedia
17    msoTextBox
18    msoScriptAnchor
19    msoTable
20    msoCanvas
21    msoDiagram
22    msoInk
23    msoInkComment

「FCList」

0    xlButtonControl
1    xlCheckBox
2    xlDropDown
3    xlEditBox
4    xlGroupBox
5    xlLabel
6    xlListBox
7    xlOptionButton
8    xlScrollBar
9    xlSpinner


以下、コードです。

Option Explicit

Enum ReportItems
  RIDummyS
  objName
  objtypen
  objType
  objTypename
  objCaption
  objValue
  objProgid
  RIDummyZ
End Enum
 
Sub Sample()
  Dim obj As Shape
  Dim i As Long
  Dim ctr As Long
  Dim v(1 To RIDummyZ - 1)
  Dim ListSh As Worksheet
  
  Set ListSh = Sheets("Sheet2")
  With ListSh
    .Cells.ClearContents
    .Range("A1:G1").Value = Split("オンジェクト名 Type(MsoShapeType) Type TypeName Caption Value PtogID/FormControlType")
  End With
  
  ctr = 1
  
  For Each obj In Sheets("Sheet1").Shapes
  
    For i = LBound(v) To UBound(v)
      v(i) = "#N/A"
    Next
    
    On Error Resume Next
    v(objName) = obj.Name
    v(objtypen) = Application.VLookup(obj.Type, Range("msoList"), 2, False)
    v(objType) = obj.Type
    v(objTypename) = TypeName(obj.DrawingObject)
    If obj.Type = 12 Then 'OLEObject
      v(objCaption) = obj.DrawingObject.Object.Caption
      v(objValue) = obj.DrawingObject.Object.Value
      v(objProgid) = obj.DrawingObject.progID
    Else
      v(objCaption) = obj.DrawingObject.Caption
      v(objValue) = obj.DrawingObject.Value
      v(objProgid) = Application.VLookup(obj.FormControlType, Range("FCList"), 2, False)
    End If
    
    On Error GoTo 0
    
    ctr = ctr + 1
    ListSh.Cells(ctr, 1).Resize(, UBound(v)).Value = v
    
  Next
  
  ListSh.Range("A1").CurrentRegion.Columns.AutoFit
  
End Sub

【73481】Re:オートシェイプのプロパティの種類と...
お礼  すが分  - 13/1/14(月) 22:15 -

引用なし
パスワード
   難しいということが分かりましたが、なすすべがないというわけでもないということで、これからいろいろやってみようと思います。
おふたかたにお礼申し上げます。

1569 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free