No.5ベストアンサー
- 回答日時:
MsoAutoShapeType 列挙には見つかりませんね。
msoShapeNotPrimitive オートシェイプの透明と言う事のようですが、、
サポートされていないようですね。
https://excelwork.info/excel/constmsoautoshapety …
やはり…。
No,3の回答を参考に活用させていただきます。
確認方法なども教えていただき大変勉強になりました。
最後までありがとうございました!!
No.4
- 回答日時:
処理できないオートシェイプがあるのですね。
そのShapeが何に該当して、TextFrame オブジェクトを.TextFrame プロパティで取得できているか調べないと分かりません。
Shape種別 参考:https://www.relief.jp/docs/excel-vba-list-msosha …
実行出来ないShapeを新規シートにコピペしてそのシートに対し
On Error Resume Next をコメントにして#3を実行
エラー部分をデバッグ、エラーが発生しない場合も、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
こんな書き方も出来ます。
参考まで
No.3
- 回答日時:
頓珍漢な回答を重ねてしまい、度々すみません。
グループ化していたのですね。
下記で試してください。。。
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
何度もありがとうございます。
こちらでおおむね色変更できました!
ただ教えていただいたマクロでも一部色変換されないテキストがありました。
同じ形(円:塗りつぶしなし)のオートシェイプを新たに作成しテキストの編集で
テキストを追加したのち、マクロを実施すると正しく色変更するので、
古いExcelバージョンで作成されたオートシェイプ
だからなのかな…といったところです。
もしご存知でしたら、教えてください。
No.2
- 回答日時:
実行時エラーですか、、
>シート内に複数のオートシェイプがある状態
オートシェイプしかないと思ってしまいました。。画像などもあるのですね。すみません。
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の下に入れてください。。
エラーになっても無視して次の行(下)に進みます。結果、エラーが出ないシェイプについて実行されます。
コードごとにメモを入れましたので、参考にされてください。
No.1
- 回答日時:
こんばんは、
>オートシェイプ内の赤文字だけを黒文字に 変更するマクロを教えてください。
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
取敢えず、ご質問の場合、このような感じでは、どうでしょう。
条件の変更、追加はご自身で調べてください。
早速の回答ありがとうございます。
実行してみましたが、For i = 1 To Len(shp.TextFrame.Characters.Text)
のところで止まってしまいました。
そこで、とりあえず、For i =1 to 20 として、実行してみると今度は
If .Characters(i, 1).Font.Color = RGB(255, 0, 0) Then
で止まってしまいました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) エクセルのマクロについて教えてください。 1 2023/02/25 16:07
- Visual Basic(VBA) 特定の文字を簡単な操作で半角スペースに変換するか削除したい 2 2022/11/01 10:35
- Excel(エクセル) エクセルのマクロについて教えてください。 1 2023/03/01 15:44
- Excel(エクセル) マクロ削除再抽出する方法を教えて下さい。 6 2022/11/26 11:03
- Visual Basic(VBA) エクセルのマクロについて教えてください。 4 2023/03/02 08:40
- Visual Basic(VBA) VBAでPowerPointからExcelにレイアウト通りに出力する 4 2023/07/05 12:22
- Excel(エクセル) シート名を簡単に書く方法があれば教えてください。 4 2023/08/24 12:40
- Excel(エクセル) マクロを教えてください 1 2022/11/28 14:52
- Visual Basic(VBA) エクセルのマクロについて教えてください。 4 2023/07/15 16:33
- Visual Basic(VBA) エクセルのマクロについて教えてください。 2 2023/07/10 09:06
このQ&Aを見た人はこんなQ&Aも見ています
-
「どうして捨てられないの?」前妻の物を捨てられない男性の心理って?
前妻の物を捨てられない理由に加え、捨てるための手段はあるのかを専門家に聞いてみた!
-
Excel VBAでオートシェイプ内の文字列を検索し、色を変えたい
Excel(エクセル)
-
テキストボックス中の文字列の色を変更する方法は?
Excel(エクセル)
-
Word-VBAで文字色を一括置換したいのですが、
Word(ワード)
-
-
4
EXECLマクロでshapeがグルーフ゜化されてるかどうかを調べる方法は?
Visual Basic(VBA)
-
5
複数のテキストボックスのフォントの色を同時に変更したい
Word(ワード)
-
6
図形の特定の色を一括置換するマクロ
Word(ワード)
-
7
パワーポイントのVBAでテキストボックスに値を変更させたいです
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
実行時エラー 438になった時の...
-
■VBA■ SUMとAVERAGEの違い
-
エクセルエラー13型が一致しま...
-
なぜこんな初歩的なVBAのIf文で...
-
VBAがブレークモードになっ...
-
ExcelVBA Range クラスの Page...
-
VBSで変数の宣言はできないので...
-
プロシージャ名の取得
-
マクロでのActiveSheet.Pasteで...
-
ADODB.Streamを使用してUTF-8を...
-
ASP.NET OleDbConnectionが定義...
-
VBS実行時エラー オブジェクト...
-
実行時エラー3001「引数が間違...
-
VBAでのエラー
-
実行時エラー -'-2147417848
-
EXCEL VBAマクロ中断でデバッグ...
-
実行時エラー '32755' [キャン...
-
OLEDB.NETで接続できない
-
VBA 別シートのセルから、文字...
-
マクロでオートシェイプ内の文...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
実行時エラー 438になった時の...
-
エクセルエラー13型が一致しま...
-
【Excel VBA】マクロをボタンに...
-
実行時エラー -'-2147417848
-
マクロについて教えてください...
-
なぜこんな初歩的なVBAのIf文で...
-
VBAがブレークモードになっ...
-
実行時エラー3001「引数が間違...
-
OLEDB.NETで接続できない
-
ExcelVBA Range クラスの Page...
-
EXCEL VBAマクロ中断でデバッグ...
-
ADODB.Streamを使用してUTF-8を...
-
VBS実行時エラー オブジェクト...
-
Outlook.ApplicationをCreateOb...
-
VBSで変数の宣言はできないので...
-
なぜエラーになるのでしょうか...
-
VB6+SQL サーバー 2000 で 実行...
-
VBAでのエラー
-
Application.ActiveInspectorで...
-
Excelで下記のようにマクロを作...
おすすめ情報