マクロでオートシェイプ内の文字の色を変更したい。

Question

Excel2016のマクロを教えてください。
シート内に複数のオートシェイプがある状態で、オートシェイプ内の赤文字だけを黒文字に 変更するマクロを教えてください。(図1の状態を図２の状態にしたい。)

Qchan1962 · Accepted Answer

https://docs.microsoft.com/ja-jp/office/vba/api/office.msoautoshapetype
MsoAutoShapeType 列挙には見つかりませんね。

msoShapeNotPrimitive　オートシェイプの透明と言う事のようですが、、
サポートされていないようですね。
https://excelwork.info/excel/constmsoautoshapetype/

Qchan1962 · Answer

処理できないオートシェイプがあるのですね。
そのShapeが何に該当して、TextFrame オブジェクトを.TextFrame プロパティで取得できているか調べないと分かりません。
Shape種別　参考：https://www.relief.jp/docs/excel-vba-list-msoshapetype.html

実行出来ないShapeを新規シートにコピペしてそのシートに対し
On Error Resume Next　をコメントにして＃３を実行
エラー部分をデバッグ、エラーが発生しない場合も、shp.Typeでタイプを調べてみてください。
For Each shp In ActiveSheet.Shapes
Debug.Print shp.Type　
または、ローカルウインドウなどで調べます。
そのShape別に設定の仕方が違う場合があります。

＞古いExcelバージョンで作成されたオートシェイプだからなのかな…といったところです。

これについては、申し訳ないですが判りません。
シェイプの種類によるものでは無いかと思います。

追記：
　　　　For i = 1 To Len(shp.TextFrame.Characters.Text)
　　　　　 With shp.TextFrame.Characters(i, 1)
　　　　　　 If .Font.Color = RGB(255, 0, 0) Then
　　　　　　　　.Font.Color = RGB(0, 0, 0)
　　　　　　 End If
　　　　　 End With
　　　　Next i
は、
　　　　　　For i = 1 To Len(shp.TextFrame2.TextRange.Text)
　　　　　　　　With shp.TextFrame2.TextRange.Characters(i, 1)
　　　　　　　　　　If .Font.Fill.ForeColor.RGB = RGB(255, 0, 0) Then
　　　　　　　　　　　　.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
　　　　　　　　　　End If
　　　　　　　　End With
　　　　　　Next i

こんな書き方も出来ます。

参考まで

Qchan1962 · Answer

頓珍漢な回答を重ねてしまい、度々すみません。
グループ化していたのですね。

下記で試してください。。。

Sub Shape_FontColor()
　 Dim shp As Shape
　 Dim i As Long, j As Long, n As Long
　 On Error Resume Next
　 For Each shp In ActiveSheet.Shapes
　　  If shp.Type = msoGroup Then
　　　　n = shp.GroupItems.Count
　　　　For j = 1 To n
　　　　　 For i = 1 To Len(shp.GroupItems(j).TextFrame.Characters.Text)
　　　　　　  With shp.GroupItems(j).TextFrame.Characters(i, 1)
　　　　　　　　If .Font.Color = RGB(255, 0, 0) Then
　　　　　　　　　 .Font.Color = RGB(0, 0, 0)
　　　　　　　　End If
　　　　　　  End With
　　　　　 Next i
　　　　Next
　　  Else
　　　　For i = 1 To Len(shp.TextFrame.Characters.Text)
　　　　　 With shp.TextFrame.Characters(i, 1)
　　　　　　  If .Font.Color = RGB(255, 0, 0) Then
　　　　　　　　.Font.Color = RGB(0, 0, 0)
　　　　　　  End If
　　　　　 End With
　　　　Next i
　　  End If
　 Next shp
End Sub

Qchan1962 · Answer

実行時エラーですか、、
>シート内に複数のオートシェイプがある状態
オートシェイプしかないと思ってしまいました。。画像などもあるのですね。すみません。
On Error Resume Next　で簡単に解決できますが、

シェイプのタイプで分けるように書き換えてみます。
下記は、図形とテキストボックスを対象にします。　他のシェイプタイプは、ご自身で少し調べてください。

Sub Shape_FontColor()
　　Dim shp As Shape　　'変数宣言（シェイプ）
　　Dim i As Long　　　　’ループカウント変数
　　For Each shp In ActiveSheet.Shapes　　’アクティブシート上のシェイプ全てをループ
　　　　If shp.Type = 1 Or shp.Type = 17 Then 'msoAutoShape　'msoTextBox　’1はオートシェプ、17はテキストボックス　　ならば、
　　　　　　For i = 1 To Len(shp.TextFrame.Characters.Text)　’シェイプ内のテキストの文字数分ループ
　　　　　　　　With shp.TextFrame.Characters(i, 1)　’シェープ内テキストを1文字ずつ（Characters(i, 1)　i＝文字列のスタート1番目、2番目・・　1は、1文字数分
　　　　　　　　　　If .Font.Color = RGB(255, 0, 0) Then　’フォントの色　RGB(255, 0, 0)　赤なら
　　　　　　　　　　　　.Font.Color = RGB(0, 0, 0)　　　’RGB(0, 0, 0)　　黒に変える
　　　　　　　　　　End If
　　　　　　　　End With
　　　　　　Next i
　　　　End If
　　Next shp
End Sub

On Error Resume Nextの場合、
先のコードのDim i As Longの下に入れてください。。
エラーになっても無視して次の行（下）に進みます。結果、エラーが出ないシェイプについて実行されます。

コードごとにメモを入れましたので、参考にされてください。

Qchan1962 · Answer

こんばんは、
＞オートシェイプ内の赤文字だけを黒文字に 変更するマクロを教えてください。

Sub Shape_FontColor()
    Dim shp As Shape
    Dim i As Long
    For Each shp In ActiveSheet.Shapes
        For i = 1 To Len(shp.TextFrame.Characters.Text)
            With shp.TextFrame
                If .Characters(i, 1).Font.Color = RGB(255, 0, 0) Then
                    .Characters(i, 1).Font.Color = RGB(0, 0, 0)
                End If
            End With
        Next i
    Next shp
End Sub

取敢えず、ご質問の場合、このような感じでは、どうでしょう。
条件の変更、追加はご自身で調べてください。

マクロでオートシェイプ内の文字の色を変更したい。

処理できないオートシェイプがあるのですね。

頓珍漢な回答を重ねてしまい、度々すみません。

実行時エラーですか、、

こんばんは、

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング