Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1568 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【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 -
引用なし
パスワード
   難しいということが分かりましたが、なすすべがないというわけでもないということで、これからいろいろやってみようと思います。
おふたかたにお礼申し上げます。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1568 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free