目安箱 IV

目安箱投稿のルールはこちらをごらんください。
ご意見は電子メールで承っています。
「目安箱」は質問禁止です。技術的な質問はそれぞれの質問箱へどうぞ。

迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
16 / 107 ツリー ←次へ | 前へ→

【263】ちょっと気になる現象6 Shapeオブジェクトの塗りつぶし ichinose 10/2/11(木) 19:21 Excel[未読]

【264】Re:ちょっと気になる現象6 Shapeオブジェク... ichinose 10/2/11(木) 20:22 Excel[未読]

【264】Re:ちょっと気になる現象6 Shapeオブジェ...
Excel  ichinose  - 10/2/11(木) 20:22 -

引用なし
パスワード
   >アクティブシートに二つの黒く塗りつぶされた見た目はまったく同じの
>オートシェイプの円があります。
>
>以下のような塗りつぶしの色が黒だったら、削除する というコードを実行したところ
>
> Sub test1()
>  Dim c As Shape
>  For Each c In ActiveSheet.Shapes
>    If c.Fill.ForeColor.SchemeColor = 8 Then c.Delete
>   '---------------------------------
>  Next c
> End Sub

上記コードのエラーは、以下のコードで作成された二つのオートシェイプの円に対して
実行すると、発生します。

'=========================================================
Sub サンプル作成()
  Dim ra As Range
  Dim rc As Range
  Set ra = Range("b2")
  Set rc = Range("d2")
  With ActiveSheet.Shapes.AddShape(msoShapeOval, ra.Left, ra.Top, ra.Width, ra.Width)
    .Fill.ForeColor.SchemeColor = 8
  End With
  With ActiveSheet.Shapes.AddShape(msoShapeOval, rc.Left, rc.Top, rc.Width, rc.Width)
    .Fill.ForeColor.RGB = RGB(0, 0, 0)
  End With
End Sub

同じ黒でもSchemeColorで設定した円とRGB で設定した円、test1は、
RGBで設定した円に対してエラーが発生します。


サンプル作成で作成した円は、以下のコード(test2)だと正常に二つとも削除してくれます。

Sub test2()
  Dim c As Shape
  For Each c In ActiveSheet.Shapes
    If c.Fill.ForeColor.RGB = 0 Then c.Delete
  Next c
End Sub


又、DrawingobjectsのInterior.ColorやColorindexで判断すると
どちらでも(test3 は、Colorindexで判断、test4は、RGBで判断)削除してくれます。

'======================================================
Sub test3()
  Dim c As Object
  For Each c In ActiveSheet.DrawingObjects
    If c.Interior.ColorIndex = 1 Then c.Delete
  Next c
End Sub
'======================================================
Sub test4()
  Dim c As Object
  For Each c In ActiveSheet.DrawingObjects
    If c.Interior.Color = 0 Then c.Delete
  Next c
End Sub

こんなところでも古いオブジェクトのほうが安定しています。


ShapeのFill.ForeColor.RGB だと微妙な色の設定ができることは
認めますけどね!!


Sub サンプル作成3()
  Dim ra As Range
  Dim rc As Range
  Set ra = Range("b2")
  Set rc = Range("d2")
  With ActiveSheet.Shapes.AddShape(msoShapeOval, ra.Left, ra.Top, ra.Width, ra.Width)
    .Fill.ForeColor.RGB = RGB(220, 105, 235)
  End With
  With ActiveSheet.Ovals.Add(rc.Left, rc.Top, rc.Width, rc.Width)
    .Interior.Color = RGB(220, 105, 235)
  End With
End Sub

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
16 / 107 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:   
0
(SS)C-BOARD v3.8 is Free