| |
>アクティブシートに二つの黒く塗りつぶされた見た目はまったく同じの
>オートシェイプの円があります。
>
>以下のような塗りつぶしの色が黒だったら、削除する というコードを実行したところ
>
> 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
|
|
ichinose
- 10/2/11(木) 20:22 -
![[未読]](./data/FAQ/image/read_icon.gif){kind=icon}
