- ベストアンサー
オートシェイプの黄色いハンドルのマクロ操作
- オートシェイプの黄色いハンドルを使ったマクロ操作について紹介します。
- 調整ハンドルによるオートシェイプの形状調整方法と数字での調整について解説します。
- マクロの記録方法やmsoShapeの使い方についてお知らせください。
- みんなの回答 (5)
- 専門家の回答
質問者が選んだベストアンサー
No.4の回答者です。 No.4で書いた文章は分かりにくかったのでしょうか? 前の回答で、(1)について~(4)について までアドバイスを したものは、Wordでのみ活用できるものとして書いたつもりです。 冒頭でそのことを書いているつもりなのですが。 それはさておき、ここからはNo.4のお礼欄に書かれたことへ補足 としてのアドバイスをします。 > >Sub ShapeAdjustment() > PPT2007で適当なオートシェイプを出し、選択した状態で実行した状態でも > 「実行時エラー424 オブジェクトが必要です」というエラーが出ます。 No.1のお礼欄で同じエラーがあり、それの原因調査としてNo.3の お礼欄でExcelで正常でもPowerPointでは" ActiveSheet. "という コマンドが、PPTで認識できないのではないことを理解されている というのに、なぜWordでのアドバイスとして書いた調整値を設定 するマクロをそのままPowerPointで使おうとするのでしょうか? 基本的部分では同じように使えるマクロでも、PowerPointとWord で書き方などが一部違う場合が多いことを理解してあれば、この マクロがExcelとWordでは共通して使えるものであったとしても、 同じに使えないこともあることを認識してください。 使えない原因については、推測ですが後述で一括説明します。 > Word2007では、適当なオートシェイプを出し、選択した状態で実行した状態でも > 「実行時エラー70 書き込みできません」が出ます。 適当なオートシェイプと書いていますが、何に対して実行したのか 書かれたほうが原因を追究しやすいですよ。 おそらく黄色いハンドル(調整ハンドル)がないオートシェイプで 実行したのでしょうね。例えば[長方形]で実行したとか。 今回の質問は、調整ハンドルがあるものを対象にして、利用できる マクロを希望しているはずです。それなのに調整ハンドルがでない もので検証したりするのは、回答側にとっては迷惑です。 そもそも調整ハンドルがあるオートシェイプを対象にしての質問で あるはずなのに、それ以外も対象にするのは筋違いですよ。 No.4の添付画像も、Wordで角丸四角形を対象にして調整値の数値を 指定したもので作図したものですから。 私の回答でPowerPointで使えるものや、調整ハンドルのないものを 対象にした記述はしていないつもりです。 その前提を無視した補足などは回答側を混乱させる原因なのです。 落ち着いて、わかりやすい質問や補足をしたほうがよいですよ。 回答でも、できるだけわかりやすく書いてくれる人のほうが理解 しやすいですよね。Office関係ではくどい書き方のほうが相互に 理解するためには必要な書き方だと思いますので。 -------------------------------------------------------- ここからは、箇条書きの項目に対してのアドバイスです。 (A)について Web検索すれば、原因を突き止めるのはすぐにできたはずです。 Excel 2007 マクロの記録を使用して新しい図形、 図形の書式設定、および図形の効果を記録できません。 http://support.microsoft.com/kb/937620/ja Excel2007 [図形]マクロ記録 http://okwave.jp/qa/q6804606.html こちら↑で書いてあるように、Excel2007では図形のマクロ記録は 記録できない不具合があるようです。ハッキリ言ってOffice2007は バグだらけで使い物にならないと個人的に思っています。 私は未だに古いバージョンを使っているので、新規購入するのなら Office2010以降にするつもりでしたので。 (B)について No.4の補足欄に書いてあるマクロ記録を見ると、長方形を用意し カーソルが本文にある状態のまま記録を開始して、長方形の選択 から塗りつぶし効果でパターンを設定するところまで記録をした ものですよね。 > ActiveDocument.Shapes("Rectangle 2").Select この部分が本文から長方形を選択したことを意味していますので。 最初に、長方形がアクティブ(Selection.ShapeRangeの状態)で、 それからマクロ記録していれば応用ができるマクロ記録ができた と思いますよ。 今回必要な部分だけ書き出すとこちら↓のようになります。 Sub Macro4() ' '図形の塗りつぶし効果関連のみを設定する With Selection.ShapeRange.Fill .Transparency = 0# .Visible = msoTrue .ForeColor.RGB = RGB(0, 0, 0) .BackColor.RGB = RGB(255, 255, 255) .Patterned msoPatternLightUpwardDiagonal End With End Sub もっと簡略するならこちら↓ Sub Macro4_1() ' '図形にハッチング効果を設定する Selection.ShapeRange.Fill.Patterned msoPatternLightUpwardDiagonal End Sub このマクロは質問者のご自宅で検証するなら、Word2007のみ利用 することができるものだと思います(推測)。 (C)について 私はPowerPointについてのアドバイスできるスキルがないので、 このことについては回答しないつもりでしたが、憶測としての アドバイスでよければ書いてみます。 No.3のお礼欄にこちら↓のような記述がありますよね。 > Set myDocument = ActivePresentation.Slides(1) これでは駄目なのでしょうか? こちら↓の投稿一覧からマクロ関係を探して、勉強されては。 http://www.moug.net/faq/viewforum.php?f=7 これ以外は、私にはアドバイスはできません。 (D)について 後述すると書いたものと、(B)(C)と関連ことなのですが。 PowerPointでは" Selection "の記述の前に" ActiveWindow. "を 記載することで対応できるようです。 Sub ShapeAdjustment() ' 'PowerPointで使うことが、たぶんできると思うもの ActiveWindow.Selection.ShapeRange.Adjustments.Item(1) = 0.1 End Sub こちら↑のものが動かなくても、私には原因は分かりません。 あくまでWeb検索したものから推測したものなので。 ------------------------------------------------------- 私はこれ以上のアドバイスはできませんので、補足などされても 追加回答はしませんのであしからず。
その他の回答 (4)
- enunokokoro
- ベストアンサー率74% (3543/4732)
PowerPointでの作業を希望しているようですが、Wordで作業を する場合のアドバイスです。 (1)について オートシェイプなどの調整値は Adjustments を使うようです。 オートシェイプの種類によって細かい設定違いがありますので、 マクロ記録できれば、それで確認するのが簡単だと思います。 No.2の回答者さんの提示したURL先からも参照できますが。 Excelの場合 http://msdn.microsoft.com/ja-jp/library/microsoft.office.interop.excel.adjustments(v=office.11).aspx Wordの場合 http://msdn.microsoft.com/ja-jp/library/microsoft.office.interop.word.adjustments(v=Office.11).aspx こちら↑で書いてあるように、幅や高さとの相対値になるので オートシェイプのサイズ違いによって調整される位置が違い、 同じ値でも幅が違うと形が希望通りにならなかったりします。 この相対値では幅または高さを基準にしますが、設定をしたい オートシェイプによって基準の位置が違います。 基準になる部分は、オートシェイプの黄色いハンドルを動かす ことで、どこを基準にしているか判断できると思います。 幅と高さが違うオートシェイプで試されると判断しやすいかと 思います。 Wordに挿入したオートシェイプの黄色ハンドルで複数の調整が あるものであっても、アイテム1のみ指定するマクロです。 記録マクロで記録したものに少し補足しただけのものです。 Sub ShapeAdjustment() ' ' 選択したオートシェイプの調整値(アイテム1のみ)を設定 ' 刻めるサイズの桁数は未検証。最小値も未検証 Selection.ShapeRange.Adjustments.Item(1) = 0.1 End Sub 例えば[角丸四角形]の場合は、角の丸い部分の調整値は短辺に 対する相対値になりますので、幅または高さの短辺側を基準に 半分(0.5)以下に対する数値になります。 ( No.1 さんのマクロもそれで指定していますよね) 角の丸い部分を揃えたい場合は、短辺における丸くなる部分の 相対値から丸くなる部分の数値を計算して、他の角丸四角形に 相対値をそれぞれの短辺に対する丸くなる範囲を決定する数値 として計算させて適用します。 これで丸くなる部分が揃うように設定することができます。 N0.1の回答者さんが調べてくれていますので、オートシェイプ それぞれのアイテム数や、相対的割合での範囲及び基準などが 示されるととても参考になりますね。 (2)について これの一覧があっても調整値のアイテムまで書いた本やサイト があるのかな? 本については私は見たこともありませんし、私なりにWeb検索 して少し探しましたが見つけられなかったです。 (3)について マクロを記録するための保存先を、テンプレートではなく文書 にすることもできますので、文書名で[マクロの保存先]を指定 しておき、探すときも[マクロ]ダイアログで[マクロの保存先] を文書名にすれば一発で探せます。 http://hamay.blogspot.com/2009/01/word.html (4)について Word2007なら対応できるかもしれません。その他のOfficeでは 仕様変更でパターンでの対応ができなくなったみたいなので。 http://www.h7.dion.ne.jp/~fufu/2007/2007.html http://www.geocities.jp/oyakamassan_m/exceltips/excel2.html Sub FillPattern() ' Word2007なら塗りつぶしパターンを指定できるみたい ' 右下がりの斜線のパターンを指定する場合 Selection.ShapeRange.Fill.Patterned msoPatternWideDownwardDiagonal End Sub Office2010になって、パターンは復活したそうです。 総括 相対的割合とミリ単位などの数値との関係をどう計算するかを 考えないとならないので、ポンチ絵であれば手動で調整をして 合わせたほうが簡単かもしれませんね。 ちなみに、No.2の回答者がアドバイスしているように、検索を するだけでもかなりの情報を得ることができるかと思います。 私は古いバージョンでしか検証できないので、Office2007以降 への回答をする場合は、できるだけWeb検索してから回答をし、 検証できないながらも推測できる範囲で回答しています。 今回のものも、私の回答の半分は検索したものから得た情報を 元に、私なりの回答に補足情報ができるようにしていますので。 なお、こちら↓の過去ログは、調整値を含んで回答をしたもの。 http://okwave.jp/qa/q6095799.html
お礼
回答ありがとうございました。 >Sub ShapeAdjustment() PPT2007で適当なオートシェイプを出し、選択した状態で実行した状態でも 「実行時エラー424 オブジェクトが必要です」というエラーが出ます。 Word2007では、適当なオートシェイプを出し、選択した状態で実行した状態でも 「実行時エラー70 書き込みできません」が出ます。 ただ、Wordでは、マクロの記録をする際に、マクロの記録先を「すべての文書」ではなく、 「ファイル名.docx」にすることで、記録されたマクロを見つけだすことができました。 現在までの調査内容については、補足にて説明します。この時点で未解決事項は以下のとおりです。 以下ができれば、本問題は、(肯定的否定的はともかく)解決に様な気がします。 (A)Excel2007でオートシェイプを書いたり書式調整したりする操作をマクロ記録しようとしても、 空のマクロしか記録されない問題。 (B)補足記載のMacro4を、「Rectangle 2"にハッチングをかける」 「選択されたオートシェイプにハッチングをかける方法」 に変更する方法 (C)PPT上で。シートを選択するVBAコード (D)PPT上のオートシェイプを選択あるいは、 マウスで選択したオートシェイプを、選択された オートシェイプ(.selectionのターゲット?)として 認識させる方法。
補足
お礼で引用するために、以下記述します。 Word2007上で以下のマクロが記録でき、Word2007上で動作します。 [1]長方形を描画する Sub Macro3() ' ' Macro3 Macro ' ' ActiveDocument.Shapes.AddShape(msoShapeRectangle, 123.75, 119.25, 141.75, _ 107.25).Select End Sub [2]"Rectangle 2"にハッチングをかける。 注) ActiveDocument.Shapes("Rectangle 2").Selectの"Rectangle 2"を適切な名称に変更しないとエラー Sub Macro4() ' ' Macro4 Macro ' ' ActiveDocument.Shapes("Rectangle 2").Select Selection.ShapeRange.Fill.Transparency = 0# Selection.ShapeRange.Line.Weight = 0.75 Selection.ShapeRange.Line.DashStyle = msoLineSolid Selection.ShapeRange.Line.Style = msoLineSingle Selection.ShapeRange.Line.Transparency = 0# Selection.ShapeRange.Line.Visible = msoTrue Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0) Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255) Selection.ShapeRange.LockAspectRatio = msoFalse Selection.ShapeRange.Rotation = 0# Selection.ShapeRange.Left = 123.75 Selection.ShapeRange.Top = 119.25 Selection.ShapeRange.Fill.Visible = msoTrue Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0, 0, 0) Selection.ShapeRange.Fill.BackColor.RGB = RGB(255, 255, 255) Selection.ShapeRange.Fill.Patterned msoPatternLightUpwardDiagonal Selection.ShapeRange.RelativeHorizontalPosition = _ wdRelativeHorizontalPositionColumn Selection.ShapeRange.RelativeVerticalPosition = _ wdRelativeVerticalPositionParagraph Selection.ShapeRange.RelativeHorizontalSize = wdRelativeHorizontalSizePage Selection.ShapeRange.RelativeVerticalSize = wdRelativeVerticalSizePage Selection.ShapeRange.Left = MillimetersToPoints(13.7) Selection.ShapeRange.LeftRelative = wdShapePositionRelativeNone Selection.ShapeRange.Top = MillimetersToPoints(7.1) Selection.ShapeRange.TopRelative = wdShapePositionRelativeNone Selection.ShapeRange.WidthRelative = wdShapeSizeRelativeNone Selection.ShapeRange.HeightRelative = wdShapeSizeRelativeNone Selection.ShapeRange.LockAnchor = False Selection.ShapeRange.LayoutInCell = True Selection.ShapeRange.WrapFormat.AllowOverlap = True Selection.ShapeRange.WrapFormat.Side = wdWrapBoth Selection.ShapeRange.WrapFormat.DistanceTop = MillimetersToPoints(0) Selection.ShapeRange.WrapFormat.DistanceBottom = MillimetersToPoints(0) Selection.ShapeRange.WrapFormat.DistanceLeft = MillimetersToPoints(3.2) Selection.ShapeRange.WrapFormat.DistanceRight = MillimetersToPoints(3.2) Selection.ShapeRange.WrapFormat.Type = 3 Selection.ShapeRange.ZOrder 4 End Sub
- DreamyCat
- ベストアンサー率56% (295/524)
>>記録する方法をご存知の方がいらっしゃったら<< PPT2007のVBE上だけでメソッドに見当をつけて、 書いてみて実行して、エラーがでれば書き直してみて実行して調べながら取り急ぎ投稿したものです。 実際に何度も何度も試行しているので、エラーにはならないはずなんですが・・・・。
お礼
当方でもいただいたマクロがExcelでは正常動作するもののPPTで 正常動作しない原因を調査しました。 まず、 ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangularCallout, 100, 150, 50 _ , 100).Select でつまっていたので、AddShape+pptで検索したところ英語の記事ですが http://msdn.microsoft.com/en-us/library/bb230703(v=office.12).aspx がヒットしました。この記事記載の Sub Rect() Set myDocument = ActivePresentation.Slides(1) myDocument.Shapes.AddShape Type:=msoShapeRectangle, _ Left:=50, Top:=50, Width:=100, Height:=200 End Sub は、PPT2007のスライド1に長方形を描画します。 したがって、ActiveSheet.というコマンドが、PPTで認識できないのではないかと思います。 前記プログラムを参考に、 Sub test_withbug() Dim i As Single, j As Long ' Set myDocument = ActivePresentation.Slides(1) myDocument.Shapes.AddShape(msoShapeRoundedRectangularCallout, 100, 150, 50 _ , 100).Select For j = 1 To 2 For i = -1 To 1 Step 0.01 Selection.ShapeRange.Adjustments.Item(j) = i DoEvents Next Next Sheet1.Shapes(1).Delete Set myDocument = ActivePresentation.Slides(1) myDocument.Shapes.AddShape(msoShapeRoundedRectangle, 100, 100, 150, 150). _ Select For i = 0 To 0.5 Step 0.001 Selection.ShapeRange.Adjustments.Item(1) = i ' DoEvents Next End Sub とすると、吹き出し自体は出ますが、 Selection.ShapeRange.Adjustments.Item(j) = i でひっかかります。
- imogasi
- ベストアンサー率27% (4737/17069)
>(3)マクロの記録について Googleででも「パワーポイント2007マクロの記録」で照会すれば、 http://office.microsoft.com/ja-jp/powerpoint-help/HA010118198.aspx が直ぐ出てくるじゃないですか。 PPTやWordのVBAを使おうとしてながら、WEB照会もしてないのは意外。 >(1)感覚ではなく数字で調整ハンドル それ以前のバージョンでマクロの記録を取り、またはエクセルでマクロの記録を取り、予想を立ててやってみましたか。 #1にも出ているように、 Selection.ShapeRange.Adjustments.Item(1) = 0.2687 の Adjustments.Item(1) は使えませんか。 新しいバージョンで新しいサービスの分以外は、VBAに関しては、基本的に同じコードのままかなと思っとります。 またエクセルVBAでコードを出してみて、他のOfficeでも共通している場合は多いと思う。 わたしなど、VBAは試行がすべてです。そんなこともやってないで、プログラムが出来ますか。わからない場合は私は「どうせMSが決めたことだもの」とつぶやいて調べにとりかかっています。理屈ではなく、MSがそう決めたのだから、どこかで情報を得ないと判るはずがない。推測を効かせる部分は多くなるが。 ーー >VBAのmsoShapeコマンドがあるように思うのですが Shapeはオブジェクトではないですか。 ーー Shape プロパティは http://msdn.microsoft.com/ja-jp/library/microsoft.office.interop.excel.shape_properties(v=office.11).aspx がありましたよ。 ーー 例えばShapesの種類 エクセルの場合で調べてみました。 VBE画面で、表示ー「オブジェクト プラウザ」 msoShape* と入れてEnter 沢山の msoShapeArc のようなリストが出ます。 「ライブラリ」が「Office」になっているのは、エクセル以外でも使えると見て、試行してみては。 ーー 全般的に高度化しすぎた内容て、ソフトも3つ以上に亘り、内容も経験者で無いとわかりにくい。 いままで長年ここの質問のレベルを見ているので、推測するが、回答が出ない恐れがあり。 質問点を絞って1つずつ、質問しては。この質問も初めにソフト名が書いてなくて、あとになって数種に亘ることが判明。 初め(質問の標題等で)に明記してください。
お礼
PPT2007では、マクロの記録は相当深いところをいじらないかぎり無理かなと おもっていたのですが…。教えていただきありがとうございました。 すぐにやれる(成功できる)とは限りませんが、必ず試します。 家のPCには、2007のみが入っていて、会社のPCは2000なのですが、会社の PCで作ったものは持ち帰れないし家のPCは会社では使えないので…。 それで、Excel2007で記録をためそうとしたのですが、 Excel2007も、オートシェイプに関しては記録してくれないというありさまで…。
- DreamyCat
- ベストアンサー率56% (295/524)
おはようございます。 2つだけちょっと調べてみました。 ややこしいようでまだ一部しか調べてないのですが、 出発の手がかりにしてください。 コードの書き方は調べる途中のものなので、きちんとしていません。 Dim i As Single, j As Long ' ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangularCallout, 100, 150, 50 _ , 100).Select For j = 1 To 2 For i = -1 To 1 Step 0.01 Selection.ShapeRange.Adjustments.Item(j) = i DoEvents Next Next Sheet1.Shapes(1).Delete ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 100, 100, 150, 150). _ Select For i = 0 To 0.5 Step 0.001 Selection.ShapeRange.Adjustments.Item(1) = i ' DoEvents Next
お礼
早々のご回答ありがとうございます。 Selection.ShapeRange.Adjustments.Item(j) = i が本質で、jがハンドルの選択、iが、設定値ということですね。 ありがとうございます。 いただいたマクロ即ち、 Sub aaa() Dim i As Single, j As Long ' ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangularCallout, 100, 150, 50 _ , 100).Select For j = 1 To 2 For i = -1 To 1 Step 0.01 Selection.ShapeRange.Adjustments.Item(j) = i DoEvents Next Next Sheet1.Shapes(1).Delete ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 100, 100, 150, 150). _ Select For i = 0 To 0.5 Step 0.001 Selection.ShapeRange.Adjustments.Item(1) = i ' DoEvents Next End Sub は、PPT(2007)だと、「実行エラー424オブジェクトが必要です」となり、Excelだと、 吹き出しのしっぽが動いて最後丸になるアニメーション?が見えます。 当方でも調べたところ、以下の記事がヒットしました。 http://park7.wakwak.com/~efc21/cgi-bin/exqalounge.cgi?print+200802/08020094.txt Sub Macro1() ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, 201#, 93.75, 102#, _ 130.5).Select Selection.ShapeRange.LockAspectRatio = msoFalse Selection.ShapeRange.Height = 57# Selection.ShapeRange.Width = 113.25 Selection.ShapeRange.Rotation = 0# End Sub これについても、同様つまりExcelのみで実行されます(三角形が出てきます) Excel2007上で、マクロの記録を押した状態で上記の方法で、作成され三角形の黄色いハンドルを 操作したとき、記録されたマクロは、本文で「新たなオートシェイプを追加する作業をマクロに記録し てもカラのマクロしか記録されない」といいましたがそれと同様に、 Sub Macro2() ' ' Macro2 Macro ' ' End Sub と、空のマクロになりました。いったい2007のオートシェイプはどうなっているのだろうかと…。
お礼
回答ありがとうございました。 Office2010というのも、これまでバージョンをあげるごとに余計な機能(オートコレクト、ナチュラルインプット)を黙らせたり、本来あるべきものがなかったり(http://oshiete.goo.ne.jp/qa/6834808.html)といいことがないのでためらっていましたが…。 「仕様です」とされていることについて、一定の改善があるようで、 http://officetanaka.net/excel/excel2007/index.htm http://officetanaka.net/excel/excel2010/index.htm VBAの文法それ自身はさほど変わっていない。 http://pc.nikkeibp.co.jp/article/NPC/20060727/244547/ また、オートシェイプの(GUIからの)作り方も、2007からあまり変わっていないように見えます。 http://www.ppt-web.jp/lecture/article/lecture1_13.html http://pc.nikkeibp.co.jp/article/knowhow/20110210/1030108/?P=2 また、オートシェイプ自体に新機能があるようで、不安なような興味深いような…・ http://www.relief.jp/itnote/archives/003725.php 特にPPTがSDI化されたというのは、大感激です。 http://www.relief.jp/itnote/archives/003736.php ExcelがMDIしかできない状態にに退化したというのがうわさされていましたが、恐らく出来そうです。 http://fiorentina64.blog10.fc2.com/blog-entry-527.html http://www.doraril.com/2010/06/windows7vistaexcelsdi.html ということで、Office2010を購入することにします。 以下、同様の問題に直面した人のために、PPT2007でうまくいったものについて報告します。 *数字の後ろの#の有無の違い *黒のハッチングをかけた場合に、色がほんのり青い? は、なんとなくしか理由がわからないので、明言を避けます。 ■参考 http://www.PowerfulPowerPoint.com/ http://books.google.co.jp/books?id=x9qKWEwjua0C&pg=PR174&lpg=PR174&dq=Rotation+%3D+0%23+VBA&source=bl&ots=NjOPG7rpDu&sig=pye5kCgPOURBhZ0jUKhQR16cOuI&hl=ja# (1)図形の描画 Sub Macro1() ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeRightArrow, 114#, 132#, 246#, 210#).Select End Sub 他、よく使う図形 Sub Macro2() '長方形 ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeRectangle, 72#, 228#, 162#, 90#).Select '台形 ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeTrapezoid, 114#, 360#, 138#, 78#).Select '駐車禁止マーク ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeNoSymbol, 324#, 252#, 102#, 96#).Select 'ドーナツ ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeDonut, 270#, 234#, 192#, 156#).Select '以下名称略 ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeCurvedUpArrow, 330#, 432#, 138#, 78#).Select ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapePentagon, 486#, 252#, 132#, 96#).Select ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeChevron, 510#, 420#, 102#, 84#).Select ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeCross, 48#, 432#, 96#, 84#).Select ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeRoundedRectangle, 48#, 348#, 108#, 72#).Select ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeRightTriangle, 222#, 330#, 162#, 150#).Select ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeIsoscelesTriangle, 444#, 192#, 186#, 144#).Select ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeBlockArc, 48#, 162#, 156#, 138#).Select ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeFlowchartDecision, 330#, 192#, 264#, 108#).Select ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeCan, 258#, 174#, 186#, 222#).Select ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeOval, 264#, 90#, 312#, 54#).Select ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeFlowchartStoredData, 36#, 270#, 198#, 114#).Select ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeFlowchartPredefinedProcess, 222#, 54#, 162#, 96#).Select End Sub (2)図形操作 Sub ShapeAdjustment() ActiveWindow.Selection.ShapeRange.Adjustments.Item(1) = 0.1 End Sub Sub FillPattern() 'ハッチング ActiveWindow.Selection.ShapeRange.Fill.Patterned msoPatternWideDownwardDiagonal End Sub Sub 消去() ActiveWindow.Selection.ShapeRange.Delete End Sub [補足欄に続く。]
補足
[続き] Sub オートシェイプ操作() ' ''セレクト解除 ActiveWindow.Selection.Unselect '特定のオートシェイプをセレクト ' ActiveWindow.Selection.SlideRange.Shapes("AutoShape 29").Select '矢印挿入 ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeUpArrow, 216#, 102#, 84#, 150#).Select '色変更 With ActiveWindow.Selection.ShapeRange .Fill.Visible = msoTrue .Fill.Solid .Fill.ForeColor.SchemeColor = ppForeground End With 'ハッチング With ActiveWindow.Selection.ShapeRange .Fill.Visible = msoTrue .Fill.ForeColor.SchemeColor = ppForeground .Fill.BackColor.RGB = RGB(255, 255, 255) .Fill.Patterned msoPatternLightHorizontal End With 'アジャスト With ActiveWindow.Selection.ShapeRange .Adjustments.Item(1) = 0.3383 .Adjustments.Item(2) = 0.2753 End With '線なし ActiveWindow.Selection.ShapeRange.Line.Visible = msoFalse '線復活 With ActiveWindow.Selection.ShapeRange .Line.Visible = msoTrue .Line.ForeColor.SchemeColor = ppForeground .Line.BackColor.RGB = RGB(255, 255, 255) End With '高さ幅 With ActiveWindow.Selection.ShapeRange .Height = 283.38 .Width = 141.75 End With '高さだけ ActiveWindow.Selection.ShapeRange.Height = 141.75 '30度回転(時計回りに30度回転) ActiveWindow.Selection.ShapeRange.Rotation = 30# '-30度回転(反時計周りに30度回転) ActiveWindow.Selection.ShapeRange.Rotation = 330# '平行移動 With ActiveWindow.Selection.ShapeRange .Left = 283.38 .Top = 283.38 End With End Sub (3)テキストボックス操作 Sub テキストボックス() 'テキストボックス挿入 ActiveWindow.Selection.SlideRange.Shapes.AddTextbox(msoTextOrientationHorizontal, 84#, 78#, 330#, 36#).Select ActiveWindow.Selection.ShapeRange.TextFrame.WordWrap = msoTrue ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select '文字挿入 With ActiveWindow.Selection.TextRange .Text = "あああ" With .Font .NameAscii = "Times New Roman" .NameFarEast = "MS Pゴシック" .NameOther = "Times New Roman" .Size = 24 .Bold = msoFalse .Italic = msoFalse .Underline = msoFalse .Shadow = msoFalse .Emboss = msoFalse .BaselineOffset = 0 .AutoRotateNumbers = msoTrue .Color.SchemeColor = ppForeground End With End With '中央ぞろえ ActiveWindow.Selection.ShapeRange. _ TextFrame.TextRange.Paragraphs(Start:=1, Length:=1). _ ParagraphFormat.Alignment = ppAlignCenter '文字サイズ変更 ActiveWindow.Selection.ShapeRange. _ TextFrame.TextRange.Characters(Start:=1, Length:=4).Select ActiveWindow.Selection.TextRange.Font.Size = 12 '塗りつぶし With ActiveWindow.Selection.ShapeRange .Fill.Visible = msoTrue .Fill.Solid .Fill.ForeColor.RGB = RGB(0, 255, 255) End With '枠線 With ActiveWindow.Selection.ShapeRange .Line.Visible = msoTrue .Line.ForeColor.SchemeColor = ppForeground .Line.BackColor.RGB = RGB(255, 255, 255) End With 'ハッチング With ActiveWindow.Selection.ShapeRange .Fill.Visible = msoTrue .Fill.ForeColor.RGB = RGB(0, 255, 255) .Fill.BackColor.RGB = RGB(255, 255, 255) .Fill.Patterned msoPatternDarkDownwardDiagonal End With 'ハッチング With ActiveWindow.Selection.ShapeRange .Fill.Visible = msoTrue .Fill.ForeColor.SchemeColor = ppTitle .Fill.BackColor.RGB = RGB(255, 255, 255) .Fill.Patterned msoPatternLightDownwardDiagonal End With End Sub