【Excel VBA tips】図形内のテキスト置換・条件付き図形色塗りの方法(マクロ)

どうも、浜男です。

先日、職場が変わりまして、4年ぶりくらいにエクセルのマクロを触ったりしてます。

とても便利なツールですが、慣れてないと色々と調べてる時間の方が長くかかってしまいます。。

下記、便利だったのでメモとして残しときます。コピペで貼り付けるだけ!(ちなみにエディタは、エクセル上でAlt+F11で開く。)

図形内の文字置換方法

単なる文字置換であれば、Ctrl+Hで簡単に出来ちゃいますが、図形内の文字はそうはいかないんですよね。。

修正箇所が沢山ある場合、いちいち図形をダブルクリックして修正して、、というのも手間です。

そこで下記!

Sub test()
Dim sheet As Worksheet
Dim shp As Shape
Dim xFindStr As String
Dim xReplace As String
xFindStr = Application.InputBox("Find:", xTitleId, "", Type:=2)
xReplace = Application.InputBox("Replace:", xTitleId, "", Type:=2)

Set sheet = Application.ActiveSheet
On Error Resume Next

For Each shp In sheet.Shapes
    xValue = shp.TextFrame.Characters.Text
    shp.TextFrame.Characters.Text = VBA.Replace(xValue, xFindStr, xReplace, 1)
Next
End Sub

特定の図形を色塗り(図形内テキストの条件分岐)

仕事をしていると、「特定の図形だけ色塗りしたい」みたいなケースがあるかと思います。

そこで、下記!

Sub test()
Dim xWs As Worksheet
Dim shp As Shape

Set xWs = Application.ActiveSheet
On Error Resume Next

For Each shp In xWs.Shapes
    xvalue = shp.TextFrame.Characters.Text
    If xvalue > 120 Then
    shp.Fill.ForeColor.RGB = RGB(255, 0, 0)
    shp.TextFrame.Characters.Font.Color = RGB(255, 255, 255)
    ElseIf xvalue > 100 And xvalue < 120 Then
    shp.Fill.ForeColor.RGB = RGB(255, 0, 0)
    shp.Fill.Patterned 3
    shp.TextFrame.Characters.Font.Color = RGB(0, 0, 0)
    End If
Next
End Sub

上記の例では、

・120以上の値が入力された図形は、赤色で塗って、文字は白。

・100以上120以下の値が入力された図形は、20%の赤色で塗って、文字は黒

となるように設定されています。

ちなみに、RGB(赤、緑、青)で、「RGB(0,0,0)=白」、「RGB(255,255,255)=黒」です。

図形の塗り方(20%,50%など)は、Patternedメソッドで指定が可能で、下記のサイトが上手くまとまっていました。

Excel VBA 図形の塗りつぶしを設定

少しずつスキルアップしていきます!

シェアする

  • このエントリーをはてなブックマークに追加

フォローする