[[20100829124016]]　『オートシェープをグル－プ化したあとのマクロについて』　（初心者）　ページの最後に飛ぶ

『オートシェープをグル－プ化したあとのマクロについて』　（初心者）

 オートシェープを複数つくりました。マクロでそれぞれ中に文字を
 書いたり、線の色を変更したりしています。
 そのオートシェープをグル－プ化し、マクロを実行化すると対象の
 オートシェープがないとのエラーになります。
 グループ化したあとのそれぞれのオートシェープにたいするマクロの
 実行はどのようにコードを書くのでしょうか。

 > そのオートシェープをグル－プ化し、マクロを実行化すると対象の
 > オートシェープがないとのエラーになります。
 > グループ化したあとのそれぞれのオートシェープにたいするマクロの
 > 実行はどのようにコードを書くのでしょうか。

 私自身は図形に興味がないので、実際にやった事ありませんが、XL2007のヘルプによると、

 『グループ化された図形は 1 つの図形として扱われる・・』

 となっていますので、グループ化前の一図形を分離処理したい場合は、
 当該Shapes.RangeをUngroupメソッドでグループ化前に戻し、
 所要処理を実行後、再度、Regroupメソッドで元のグループ戻す。

 と云うことになりそうな気がします。

 (半平太) 2010/08/29 15:31

 半平太さん。ありがとうございます。やってみます。
 結果については後ほど書き込みさせて頂きます。（初心者）

 やってみた結果ですが、
 オートシェープ１とオートシェープ２をグループ化して
 グループ１にしました。
 マクロの自動記録でこのグループ１のグループ化の解除を
 記憶しました。
 マクロでグループを解除したことで
 オートシェープ１とオートシェープ２にマクロは実行できました。
 が 再度、オートシェープ１とオートシェープ２をグループ化すると
 グループ２になりました。
 グループを解除をするマクロのｺｰﾄﾞが対象がグループ１のままなので
 エラーとなります。
 一旦グループ化したグループの解除／再グループ化を実行するには
 そうすえばいいでしょうか。グループはひとつなので、全グループ
 のグループの解除とか、グループに名前をつけて、名前で解除とか
 そういった方法があるのかどうか全くわかりませんが、もしあれば
 教えていただけないでしょうか。（初心者）

 >グループはひとつなので、
 グループがひとつなら、名前(例：グループ１) で特定せず、(それは一定でないから）
 インデックス番号で指定したら如何ですか？（それは常に1番です・・・と思う）

 例：　Shapes.Range(1).Ungroup　　グループ化解除
 　　　Shapes.Range(1).Regroup　　再グループ化

 (半平太) 2010/08/29 19:44

 半平太さん、再度の説明ありがとうございます。すぐに書き込みできず
 すみません。マクロのコードをかくことがあまり経験がなく説明して頂いて
 いることが飲み込めなくてすみません。
 （それは常に1番です・・・と思う）とは
　Shapes.Range(1).Ungroupの１は１固定ということでしょうか。今グループ
 化したグループの番号は何回も登録、解除を繰り替えしているので２６に
 なっています。　Shapes.Range(26).Ungroup　とし実行すると、実行時エラー
 ４２４（オブジェクトが必要）となります。
 １とはｸﾞﾙｰﾌﾟ番号を１にする必要があるということでしょうか。（初心者）。

 後戻りして済みませんが、最初に前提を明確にしていただけますか？

 １．コードはどこに書かれていますか？（シート/標準)

 ２．オリジナルの図形の数は幾つありますか？
 　(1)2つだけで、それをグループ化しているだけ？
 　(2)沢山あるが、グループ化しているのはその内の特定の2つだけ？
 　(3)増減するが、グループ化しているのはその内の特定の2つだけ？

 (半平太) 2010/08/30 06:00

 <追記>
 ３．バージョンによって、出来ることが違って来そうなので、エクセルのバージョンも教えてください。

 Groupメソッド及び、Regroupメソッド共にグループ化及び、再グループ化された
 図形オブジェクトを返しますから、これにユニークな名前を付けたらどうですか？

 新規ブックにて、標準モジュールに

 '================================================================
 Option Explicit
 Sub test()
    Const gshp = "グループ化された図形"
    Dim g0 As Long
    Dim nm(1 To 2)
    Dim shp As Shape
    With ActiveSheet
       .DrawingObjects.Delete
       With .Rectangles.Add(100, 100, 100, 100)
          nm(1) = .Name
       End With
       With .Ovals.Add(100, 100, 100, 100)
          nm(2) = .Name
       End With
       DoEvents
       MsgBox "二つの図形をグループ化します"
       With .Shapes.Range(nm()).Group
          .Name = gshp
       End With
       DoEvents
       MsgBox "二つの図形をグループ化しました" & vbCrLf & _
              "このグループ化された図形を赤と青に塗りつぶします"
       g0 = 12
       For Each shp In .Shapes(gshp).GroupItems
          shp.Fill.ForeColor.SchemeColor = g0
          g0 = 10
       Next
       '↑一部の処理はグループ化解除しなくても可能
       DoEvents
       MsgBox "円の中にichinoseと書き込みます"
       .Shapes(gshp).Ungroup
       With .Shapes(nm(2))
          .TextFrame.Characters.Text = "ichinose"
          'テキストの書き込みは、Excel2002では解除しなくてはできなかった
       End With
       With .Shapes.Range(nm(2)).Regroup
          .Name = gshp
       End With
    End With
 End Sub

 上記のtestを実行し、コードと処理を照らし合わせてください。

 ichinose

 初心者です。
 まず、半平太さん、ichinoseさん、にお詫します。せっかく教えて頂いて
 いるのに返事が大変遅くなり申し訳けありません。当方の環境がオンライ
 のＰＣにすぐ触れる環境ではなく、実際の運用しているＰＣはオフライン
 なのでオフラインＰＣで確認してオンラインのＰＣかこうしてアクセス
 をしています。

 まず、半平太さんへのご返事でですが
 ＥＸＣＥＬはＥＸＣＥＬ２００３です。

 作成しているコードですが
 マクロの自動記録で作成して
 Sub Macro8()
 'オ-トシェ-プ１の色を変える
 ' Macro8 Macro

    ActiveSheet.Shapes("Oval 1").Select
    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.Solid
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 53
    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.SchemeColor = 64
    Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)

 Sub Macro9()

 ' Macro9 Macro
 'オ-トシェ-プ２の色を変える

    ActiveSheet.Shapes("Oval 2").Select
    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.Solid
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 48
    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.SchemeColor = 64
    Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
 End Sub

 Sub Macro10()

 ' Macro10 Macro
 'オ-トシェ-プ１、オ-トシェ-プ２の色を変える

    ActiveSheet.Shapes("Oval 1").Select
    ActiveSheet.Shapes.Range(Array("Oval 1", "Oval 2")).Select
    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.Solid
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 43
    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.SchemeColor = 64
    Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
 End Sub

 オ-トシェ-プ１とオ-トシェ-プ２をグループ化をする（グループ３０）というグループ ができる

 Sub Macro8()を実行すると
実行時エラー１００４となります

 具体的な説明は以上ですが
 説明不足ですみませんでした

 ichinoseさん。コードのご提示ありがとうごじました。
 教えて頂いたコードを１ステップずつ実行し結果を確認しました。
 私のイメージではわかる範囲では以下になります。
 結果的には今ある図形は全て消し、青の四角、赤の丸ができグループ化する
 グループを解除し丸のオ-トシェ-プｎｍ（２）の中に 「ichinose」と書き込み
 再グループをする
・・・結果からはこうなると思うのですが
 最後のほうの
 With .Shapes.Range(nm(2)).Regroup　これがイメージがわきません。
 Regroup（リグループ）のイメージがわかりません。nm(2）ひとつの
 オ-トシェ-プをグループ化しているように見えます。・・・どういう風に
 理解すればいいのでしょう。

  ＞上記のtestを実行し、コードと処理を照らし合わせてください。との
 ことですが、やはりチンプンカンプンで、具体的にどうすれば今ある
 グループ化してある複数のオ-トシェ-プを一旦グループ化解除して各
 オ-トシェ-プの設定を変更すればいいのかがイメージできません。
 よろしければ教えて頂けないでしょうか

 Option Explicit
 Sub test()
    Const gshp = "グループ化された図形"
    Dim g0 As Long
    Dim nm(1 To 2)
    Dim shp As Shape
    With ActiveSheet
       .DrawingObjects.Delete '（初心者）シート上の図形をすべて消す
       With .Rectangles.Add(100, 100, 100, 100)
                              '（初心者）四角を書く（１００はサイズと思います）
          nm(1) = .Name      '（初心者）自動的に四角につけられら名前をｎｍ（１）へ書き込み
       End With
       With .Ovals.Add(100, 100, 100, 100)
                             '（初心者）丸を書く（１００はサイズと思います）
          nm(2) = .Name    '（初心者）自動的に丸につけられら名前をｎｍ（２）へ書き込み
       End With
       DoEvents    '（初心者）わかなない
       MsgBox "二つの図形をグループ化します" '（初心者）上記MSGBOXを出す
       With .Shapes.Range(nm()).Group
                   '（初心者）対象となった図形・・・ここではnm(1)とnm(2)をグル-ﾌﾟ化
          .Name = gshp  '（初心者）グループ化された図形’という名をつける
       End With
       DoEvents
       MsgBox "二つの図形をグループ化しました" & vbCrLf & _
              "このグループ化された図形を赤と青に塗りつぶします"
                '（初心者）上記MSGBOXを出す
       g0 = 12 '（初心者）ここもやや不明ですが　０～１２までという意味かな
       For Each shp In .Shapes(gshp).GroupItems
                 '（初心者）ここもわかりません
          shp.Fill.ForeColor.SchemeColor = g0
                   '（初心者）該当オ-トシェ-プにｇ０に入っている数字の色をつける'
          g0 = 10
                  '（初心者）ｇ０～１０まで　すぐ上でg0 = 12があるのにここでg0 = 10もよくわかりません
       Next '（初心者）次へ'

       '↑一部の処理はグループ化解除しなくても可能
       DoEvents '（初心者）わかりません
       MsgBox "円の中にichinoseと書き込みます"
             '（初心者）上記MSGBOXを出す
       .Shapes(gshp).Ungroup '（初心者）グループ「グループ化された図形」を解除
       With .Shapes(nm(2)) '（初心者）nm(2)のオ-トシェ-プに以下の処理をする
          .TextFrame.Characters.Text = "ichinose" '（初心者）該当のオ-トシェ-プにichinoseと記入
          'テキストの書き込みは、Excel2002では解除しなくてはできなかった
       End With
       With .Shapes.Range(nm(2)).Regroup '（初心者）ここが一番わかりません。nm(2)のみしか再グループかしていないような
           'nm(1)とnm(2)をグルプするのではないのかな？　でも２つがグループになっています。

          .Name = gshp 'グループ化された図形というグループ名をつける
       End With
    End With
 End Sub
 実際のマクロコードの箇所を本文に貼り付けました。醜くてすみません。

 また、すぐに見れる環境ではないので、ご返事が遅くなる可能性がありますが
 よろしくお願いします。

私が提示したコードについて

 提示したコードに対して、これだけきちんと疑問をぶつけてこられたのは、
 このサイトでは記憶にないくらい久しいなあ。

 さて、全体の処理は、
 >今ある図形は全て消し、青の四角、赤の丸ができグループ化する
 >グループを解除し丸のオ-トシェ-プｎｍ（２）の中に 「ichinose」と書き込み
 >再グループをする

 このとおりです。
 図形を全て削除したのは、このコードを何回も繰り返し実行できるようにするためです。

 再グループ化は、以前グループ化されていれば、そのグループ化を再現する
 機能ですよね？　これ、ひとつの図形だけで処理が可能なんです。
 ご自分で　二つ図形を作成し、グループ化して、解除し、
 その一つのだけを選択し、右クリック---グループ化----再グループ化で
 以前行ったグループ化が再現できることを確認してください。

 よって、.Shapes.Range(nm(2)).Regroup
 このコードでnm(2)という名前で定義された図形が直前にグループ化された状態に
 復元できます。

 Msgbox "・・・・・"
 直前の　Doevents　は、図形に処理した途中経過（図形を作成したり、色をつけたり等）がわかるように一度、Windowsに制御を戻しています。

 これを入れないと、Msgboxでの途中経過を表示することができませんでした（Excel2002で確認）。
 こういう意味ですから、図形を作成し、グループ化して、色付けして　文字を入れる
 という最後の結果だけが求められるなら、要りません。DoEventsをとって
 実行して違いを確認してください。

      >g0 = 12 '（初心者）ここもやや不明ですが　０～１２までという意味かな
      >For Each shp In .Shapes(gshp).GroupItems
      >           '（初心者）ここもわかりません
      >    shp.Fill.ForeColor.SchemeColor = g0
      >             '（初心者）該当オ-トシェ-プにｇ０に入っている数字の色をつける'
      >    g0 = 10
      >            '（初心者）ｇ０～１０まで　すぐ上でg0 = 12があるのにここでg0 = 10もよくわかりません
      > Next '（初心者）次へ'
 ここは、グループ化された図形　と命名されたグループ化した図形から、グループ化された図形を取り出しています。

 ここでは、二つの図形がグループ化されていますから、
 その一つは　青（色番号12）、もう一つは赤（色番号10）で塗りつぶしています。

 コードの説明は以上ですが、

 このコードでグループ化した図形に予め用意した名前（コードでは、グループ化された図形）
 を用意して、グループ化するたびにその名前で命名すればよい　という例を
 示したつもりだったのですが、初心者さんが提示されたコードを拝見すると、
 このコード例では初心者さんの要件を満たしていないかもしれません。

 >オ-トシェ-プ１とオ-トシェ-プ２をグループ化をする（グループ３０）というグループ ができる

これのコードを提示されないのは、これはコードではなく、手動操作で行っているということですか？

Macro8～Macro10を対象図形がグループ化されていてもいなくても
作動できるようにしたいという意味でしょうか？

 そうだとしたら、Macro8からMacro10でそのようなチェック処理をしなければなりません。

 そうではなく、
 図形のグループ化もコードで行うならその都度特定の名前をつければ
 処理が可能になると思います。

 ichinose

 ＞ 作成しているコードですが
 １．私は、具体的なコードをお聞きしたのではなく（そこまでは立ち入らない）、
 　　コードが書かれている場所（シートモジュール か 標準モジュール）を、
 　　お尋ねしただけです。それによって、コードの書き方が変わる為です。

 　　まぁ、「マクロの自動記録で作成」とのことなので、
 　　標準モジュールであろうことは、結果的には分かりました。

 ＞オリジナルの図形の数は幾つありますか？
  >(1)2つだけで、それをグループ化しているだけ？
  >(2)沢山あるが、グループ化しているのはその内の特定の2つだけ？
  >(3)増減するが、グループ化しているのはその内の特定の2つだけ？
 ２．私は「グループはひとつ」と云うことしか分かっていないので、
 　 グループ化しない図形が他にもあるのかどうか知りたかったのです。
 　（図形の状況が決め打ちできるなら、コードが単純になる為です→代わりに、柔軟性は無くなりますけどね。）

 　ただ、こんなこと何回もお聞きするのは無駄なので、
    「他にも図形はあるが、クループ化しているのは、Shapes("Oval 1")とShapes("Oval 2")だけ」
   と云う前提とします。

 ３．さて、上記２つの図形は（手動であれ、マクロであれ）
　「既にグループ化されている状態」を出発点として考えます。

 ※ Macro8 を実現するにはtest8
 ※ Macro9 を実現するにはtest9
 ※ Macro10を実現するにはtest10を実行する

  <考え方>
 （1）Functionプロシージャで以下の処置をして、グループ名を取得する。
 　　図形を片っ端から読んで、グループ化されたものかどうか判断し、
 　　グループ化されたものがあれば、それが処理対象の図形なので、
 　　そのグループ名を返させる。

  (2)　グループ名が分かったら、そのグループ名を使って、グループを解除する。

 （3）Macro（８or９or１０）を実行して、色づけする。

 （4）色づけ終了後、再グループ化する。（→出発点に戻る）

 Sub test8()
     ActiveSheet.Shapes(GrName).ungroup
     Macro8
     ActiveSheet.Shapes("Oval 1").Select
     Selection.ShapeRange.regroup
 End Sub

 Sub test9()
     ActiveSheet.Shapes(GrName).ungroup
     Macro9
     ActiveSheet.Shapes("Oval 1").Select
     Selection.ShapeRange.regroup
 End Sub

 Sub test10()
     ActiveSheet.Shapes(GrName).ungroup
     Macro10
     ActiveSheet.Shapes("Oval 1").Select
     Selection.ShapeRange.regroup
 End Sub

 Function GrName()
     Dim Shp As Shape
     Dim grpFactor As Shape
     Dim isGroup As Boolean

     For Each Shp In ActiveSheet.Shapes
         On Error Resume Next
             Set grpFactor = Shp.GroupItems(1)
             If Err.Number <> 0 Then
                 isGroup = False
             Else
                 isGroup = True
             End If
          On Error GoTo 0

          If isGroup Then
             GrName = Shp.Name
             Exit For
          End If
     Next

 End Function

 (半平太) 2010/08/31 14:02

横から失礼します。

初心者さんが疑問視している部分についてですが、何もないシートで↓を何度も実行すると、オートシェープに勝手に付く名前やグループ化したときの名前の番号がどんどん加算されるのはおわかりだと思います。

要するに何も指定しないと、名前がどんどん変化していってしまうということですね。

 Sub test()
 ActiveSheet.DrawingObjects.Delete

 ActiveSheet.Rectangles.Add(20, 20, 50, 50).Select
 ActiveSheet.Ovals.Add(40, 40, 50, 50).Select
 ActiveSheet.Shapes.Range(Array(1, 2)).Select
 Selection.ShapeRange.Group
 ActiveSheet.Shapes.Range(Array(1)).Select
 Selection.ShapeRange.Ungroup
 ActiveSheet.Shapes.Range(Array(1)).Select
 Selection.ShapeRange.Regroup
 End Sub

でも、このコードでは常に選択できていますよね？

それはindexと呼ばれる番号で図形を指定しているからで、オートシェープが2個しかないときは1と2で、グループ化して1個になってしまったら1なわけです。名前がなんであろうと関係ありません。

このあたりが半平太さんが説明している部分なんですが、では2個あるときのどっちが1でどっちが2か？　というのは図の前後関係で変化するので、オートシェープがたくさんある場合は特定が困難です。

また、オートシェープが3つあって、うち2つをグループ化するなんていう状況だと、対象のオートシェープを特定するのが更に大変ですよね？

このあたりを踏まえれば半平太さんが質問していることがわかってくると思います。

で、ichinoseさんのほうは、勝手に変化していってしまう名前を自分で付けかえてしまえばえ～じゃないか、というやり方です。

"グループ１"だろうが"グループ３０"だろうが、"グループ化された図形"に付けかえるということですね。

（ramrun）余計なお世話かな

 >これのコードを提示されないのは、これはコードではなく、手動操作で行っていると  うことですか？

 >Macro8～Macro10を対象図形がグループ化されていてもいなくても作動できるようにしたいという意味でしょうか？

 こういう意味だとすると結構厄介でした。

 新規ブックにて試してください。

 まず、標準モジュール（Module1）に、サンプルの図形を作成します。

 '==================================
 Option Explicit
 Sub 準備()
    With ActiveSheet
       .DrawingObjects.Delete
       With .Shapes.AddShape(msoShapeOval, 100, 100, 100, 100)
          .Name = "Oval1"
       End With
       With .Shapes.AddShape(msoShapeOval, 125, 125, 50, 50)
          .Name = "Oval2"
       End With
    End With
 End Sub

 別の標準モジュール（Module2）に初心者さんが提示された
 Macro8～Macro10の変更コード

 '===============================================================
 Sub Macro8()
    With open_shp(ActiveSheet, "Oval1")
       .Fill.Visible = msoTrue
       .Fill.Solid
       .Fill.ForeColor.SchemeColor = 53
       .Fill.Transparency = 0#
       .Line.Weight = 0.75
       .Line.DashStyle = msoLineSolid
       .Line.Style = msoLineSingle
       .Line.Transparency = 0#
       .Line.Visible = msoTrue
       .Line.ForeColor.SchemeColor = 64
       .Line.BackColor.RGB = RGB(255, 255, 255)
    End With
    Call close_shp
 End Sub
 '===========================================================
 Sub Macro9()
    With open_shp(ActiveSheet, "Oval2")
       .Fill.Visible = msoTrue
       .Fill.Solid
       .Fill.ForeColor.SchemeColor = 48
       .Fill.Transparency = 0#
       .Line.Weight = 0.75
       .Line.DashStyle = msoLineSolid
       .Line.Style = msoLineSingle
       .Line.Transparency = 0#
       .Line.Visible = msoTrue
       .Line.ForeColor.SchemeColor = 64
       .Line.BackColor.RGB = RGB(255, 255, 255)
    End With
    Call close_shp
 End Sub
 '=============================================
 Sub Macro10()
    Dim pa1 As Object
    Dim pa2 As Object
    With open_shp(ActiveSheet, "Oval1")
       Set pa1 = get_parent
    End With
    Call close_shp
    With open_shp(ActiveSheet, "Oval2")
       Set pa2 = get_parent
    End With
    Call close_shp
    With ActiveSheet.Shapes.Range(Array(pa1.Name, pa2.Name))
       .Fill.Visible = msoTrue
       .Fill.Solid
       .Fill.ForeColor.SchemeColor = 43
       .Fill.Transparency = 0#
       .Line.Weight = 0.75
       .Line.DashStyle = msoLineSolid
       .Line.Style = msoLineSingle
       .Line.Transparency = 0#
       .Line.Visible = msoTrue
       .Line.ForeColor.SchemeColor = 64
       .Line.BackColor.RGB = RGB(255, 255, 255)
    End With
 End Sub
　　
 又、別の標準モジュール（Module3）にグループオブジェクトの個々のオブジェクトを
 管理するプロシジャー群

 '================================================================
 Option Explicit
 Private shtsv As Object
 Private p_shp As Object
 Private shp As Object
 Private s_type As Long '0:　通常の図形 1:グループ化された図形
 '============================================================
 Function open_shp(sht As Object, shpnm As Variant) As Variant
    On Error Resume Next
    Dim obj As GroupObject
    Dim ret As Long
    Set p_shp = Nothing
    Set shp = Nothing
    Set shtsv = sht
    ret = 1
    For Each obj In shtsv.GroupObjects
       For Each shp In obj.ShapeRange.GroupItems
          If shp.Name = shpnm Then
             ret = 0
             Set p_shp = obj.ShapeRange(1)
             s_type = 1
             Exit For
          End If
       Next
       If ret = 0 Then Exit For
    Next
    If ret = 1 Then
       Err.Clear
       Set shp = shtsv.Shapes(shpnm)
       If Err.Number = 0 Then
          s_type = 0
       Else
          Set shp = Nothing
       End If
    End If
    Set open_shp = shp
 End Function
 '============================================================
 Function get_parent() As Object
    Set get_parent = IIf(s_type = 0, shp, p_shp)
 End Function
 '============================================================
 Sub put_prp(obj, prp As String, vvalue As Variant)
    Dim snm As String
    If s_type = 0 Then
       CallByName obj, prp, VbLet, vvalue
    Else
       snm = shp.Name
       p_shp.Ungroup
       CallByName obj, prp, VbLet, vvalue
       Set p_shp = shtsv.Shapes.Range(snm).Regroup
    End If
 End Sub
 '============================================================
 Sub close_shp()
    Set shtsv = Nothing
    Set p_shp = Nothing
    Set shp = Nothing
    s_type = 0
 End Sub

 コードは、以上です。

 まず、準備を実行してサンプル図形を作成してください。

 作成された図形に対してそのまま、Macro8～Macro10を実行してみてください。
 正常に作動しますね！！

 次にMacro8～Macro10で付けられた色を塗りつぶしなしに戻してください。

 二つの円をグループ化してください。

 再度、Macro8～Macro10を実行してみてください。

 グループ化しないで実行した時と同じように正常に処理されるはずです。

 試してみてください。

 ichinose

コメント返信：

[ 一覧(最新更新順) ]

[[20100829124016]] 『オートシェープをグル－プ化したあとのマクロについて』 （初心者） ページの最後に飛ぶ

[[20100829124016]]　『オートシェープをグル－プ化したあとのマクロについて』　（初心者）　ページの最後に飛ぶ