人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

【★完全回答で 500pt ?★】
Word VBA で色付きのシェイプをモノクロにする方法

Win XP Home, Word 2003/2007 を使っています。

doc 文書内にいろいろな図 (シェイプを使用したもの) があります。これらの図は赤や青や緑など、さまざまな色の線や塗りつぶしがされています。

これを Word VBA を使って、黒と透明以外の色が設定されている線または面をモノクロに置き換える方法はありますか?

イメージとしてはこんな感じです。
for i = 0 to シェイプの数
if シェイプ(i).線 <> 黒 or 透明
シェイプ(i).線 = 黒
end if
if シェイプ(i).面 <> 黒 or 透明
シェイプ(i).面 = 黒
end if
next

最初に白黒化ができる回答をしてくれた人に 100pt、
使われている色の明度に合わせてグレースケールで濃淡が出せた場合は +500 ポイント (濃淡の精度はほどほど、例 10 or 16 段階くらいとか) を差し上げます。

テキストボックスではなくて、シェイプです。
不明点はコメント欄にお願いします。


●質問者: にぎたま
●カテゴリ:コンピュータ
✍キーワード:DOC HOME NeXT VBA WIN
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● mattn
●35ポイント

こんな感じでどうでしょうか?

Sub foo()
 Dim i, j, rgbl, r, g, b As Integer
 Dim m As Long
 For i = 1 To Me.Shapes.Count
 For j = 1 To Me.Shapes(i).CanvasItems.Count
 With Me.Shapes(i).CanvasItems(j)
 If .Line.ForeColor <> vbBlack Or .Line.Transparency = 0 Then
 rgbl = .Line.ForeColor
 r = SHR(rgbl, 16) Mod 256
 g = SHR(rgbl, 8) Mod 256
 b = rgbl Mod 256
 m = max(max(r, g), b)
 .Line.ForeColor.rgb = rgb(m, m, m)
 End If
 If .Fill.ForeColor <> vbBlack Or .Fill.Transparency = 0 Then
 rgbl = .Fill.ForeColor.rgb
 r = SHR(rgbl, 16) Mod 256
 g = SHR(rgbl, 8) Mod 256
 b = rgbl Mod 256
 m = (r + g + b) / 3
 .Fill.ForeColor.rgb = rgb(m, m, m)
 End If
 End With
 Next
 Next
End Sub

明度はRGB平均で出してますので確かなHSBじゃないですが、やってみた結果、それっぽく出なかったので平均にしてます。

明度の刻みは

m = CInt((CDbl(m) / 25.6) * 25.6)

とかすれば10段階になるかと思います。


2 ● kn1967
●35ポイント ベストアンサー

出遅れた感があるので回答すべきかとも思ったのですが・・・

カラーからモノクロへの変換部分が違うので、

回答投稿させていただく事にしました。

Function Color2Mono(s As Object)
 Dim r As Integer, g As Integer, b As Integer, mono As Integer
 r = s.rgb Mod 256
 g = Int(s.rgb / 256) Mod 256
 b = Int(s.rgb / 256 / 256)
 mono = r * 0.3 + g * 0.59 + b * 0.11
 s.rgb = rgb(mono, mono, mono)
End Function

Sub Macro1()
 Dim s As Object
 With ActiveDocument
 For Each s In .Shapes
 With s
 If .Fill.Visible = msoTrue Then '塗りつぶしありの場合はモノクロ化
 Call Color2Mono(.Fill.ForeColor)
 End If
 If .Line.Visible = msoTrue Then '線ありの場合はモノクロ化
 Call Color2Mono(.Line.ForeColor)
 End If
 End With
 Next
 End With
End Sub

※IF文に関しては回答1の方法が良いでしょうけど、

あえて、そのまま直さずにおきますね。

※ほぼ、専用関数的に作ってますので、

RGBプロパティが存在しないオブジェクトを

関数に渡すとエラーになります。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ