スキルアップ・問題解決なら、モーグにおまかせ！

エクセルブックの色外しという業務に携わっています。
読み込んだブックの全シートにおいて、セルの背景色が黄色もしくは水色のセルがある場合、色を外し、セル内に赤文字がある場合、文字を黒色にします。
また、塗り潰されたシェイプがある場合、その色も塗り潰しなしに。シェイプ内に赤文字がある場合、文字を黒色にします。
 
手作業だと結構時間がかかりますので、簡略化するために下記のようなVBAコードを作ってみました。
 
Sub セル背景色_タブ色外し2()
 
Dim sht As Worksheet
Dim c As Range
Dim BGC As Variant, OpenFileName As Variant, target As Variant
Dim FilNum As Integer, FilCnt As Integer, I As Integer
 
BGC = Array(65535, 16777164) '消去する背景色を指定
 
'Application.ScreenUpdating = False '画面表示の更新をストップ
Application.DisplayAlerts = False '警告メッセージ非表示
     
OpenFileName = Application.GetOpenFilename(MultiSelect:=True, FileFilter:="Microsoft Excelブック,*.xls;*.xlsx")
 
If IsArray(OpenFileName) Then
     
    FilNum = UBound(OpenFileName) '処理を実施するファイル数
    FilCnt = 1
 
    For Each target In OpenFileName
     
        Workbooks.Open target
         
        For Each sht In Worksheets '読み込んだブックの、全てのシートに実施
 
            sht.Activate
            Application.FindFormat.Clear '検索する書式をクリア
     
            For I = LBound(BGC) To UBound(BGC)
         
                Application.FindFormat.Interior.Color = BGC(I)
                Set c = Cells.Find(what:="", searchformat:=True)
                 
                Do While Not c Is Nothing '指定の背景色があった場合
                 
                If c.Row >= 6 Then '指定の背景色が6行目以上にあるなら、背景色をクリアー
                    c.Interior.Color = xlNone
                Else
                    Exit Do
                End If
         
                Set c = Cells.Find(what:="", after:=c, searchformat:=True)
                     
                Loop
                 
            Next I
 
FtColChng:
            Application.FindFormat.Clear
            Application.ReplaceFormat.Clear
            Application.FindFormat.Font.Color = 255 'セル内の文字色が赤だった場合
            Application.ReplaceFormat.Font.Color = vbBlack '黒に変更
            sht.Cells.Replace what:="", replacement:="", searchformat:=True, ReplaceFormat:=True
             
            If sht.Tab.ColorIndex <> xlNone Then '処理を実施しているシートタブに色がある場合
                sht.Tab.ColorIndex = xlNone 'その色をクリアー
            End If
             
            sht.Range("A1").Select
 
        Next sht
 
        Application.FindFormat.Clear
        Application.ReplaceFormat.Clear
         
        Worksheets(1).Activate
        ActiveWorkbook.Close savechanges:=True '保存して閉じる
         
        Application.StatusBar = FilCnt & "/" & FilNum & "を実行中" '全体の何番目のブックの処理が終わったか
        FilCnt = FilCnt + 1
 
    Next target
         
    'Application.ScreenUpdating = True
    Application.DisplayAlerts = True '警告メッセージ表示
    MsgBox "終了しました"
 
Else
     
    MsgBox "キャンセルされました。"
 
End If
     
End Sub
 
 
更に、以下のような処理もできれば追加したい。
・セル内に赤文字以外の文字が混在していても、赤文字のみを黒にしたい。
・シェイプ内に赤文字があれば黒に、赤文字以外の文字が混在していても、赤文字のみを黒にしたい。
・シェイプが塗り潰されている場合、塗り潰しなしにしたい。
 
上記のような事も、おそらくVBAで実現可能ではと考えているのですが、私の知識と経験では、いろいろネットを調べてみたりもしましたが、どのようなコードを書けばいいのかわかりませんでした。
どなたかお詳しい方がいらっしゃいましたら、是非御教授いただければと思いますので宜しくお願い致します。

本体は、以下のような形式にして、
実際の処理はFunctionプロシージャにdelegateしたほうが
整理しやすいのではないかと思いました。

       For Each sht In Worksheets    '読み込んだブックの、全てのシートに実施
            Call interiorColorClear(sht)
            Call fontColorRedToBlack(sht)
            If sht.Tab.ColorIndex <> xlNone Then '処理を実施しているシートタブに色がある場合
                sht.Tab.ColorIndex = xlNone      'その色をクリアー
            End If
            Call modifyShape(sht)
        Next sht

1)セル内に赤文字以外の文字が混在していても、赤文字のみを黒にしたい。
2)シェイプ内に赤文字があれば黒に、赤文字以外の文字が混在していても、赤文字のみを黒にしたい。
3)シェイプが塗り潰されている場合、塗り潰しなしにしたい。

Function modifyShape(sht As Worksheet)
    Dim shp        As Shape
    Dim characters As TextRange2 
    Dim k          As Long
    For Each shp In sht.Shapes
        If shp.TextFrame2.HasText Then
            Set characters = shp.TextFrame2.TextRange.characters
            For k = 1 To characters.Count
                '文字色が赤なら黒に
                If characters.Item(k).Font.Fill.ForeColor.RGB = RGB(255, 0, 0) Then
                    characters.Item(k).Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
                End If
            Next
        End If
        shp.Fill.Visible = msoFalse '塗りつぶしを無しに
    Next
End Function

ああ、少し勘違いしていました。
1)は済んではいなかったですね。
文字列の一部が赤になっているものを元に戻すのですね。
 
ただ、コメントに返事がないので、回答を保留します。
「独り相撲」を続けるのは余り気が進まないので。

お返事が遅くなってしまい、申し訳ありません。
ご提示いただいた、シェイプ内の赤文字と塗り潰しを解除するコードを、実業務にて使用しているブックにて検証をしておりました。
ご提示いただいたコードを参考に、以下のように実務作業にあわせて修正しました。
 
Sub シェイプ処理テスト()
 
Dim shp As Shape
Dim characters As TextRange2
Dim k As Long
 
On Error Resume Next
    For Each shp In ActiveSheet.Shapes
        If shp.TextFrame2.HasText Then
            Set characters = shp.TextFrame2.TextRange.characters
            For k = 1 To characters.Count
                '文字色が赤なら黒に
                If characters.Item(k).Font.Fill.ForeColor.RGB = RGB(255, 0, 0) Then
                    characters.Item(k).Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
                End If
            Next
            If shp.Top > 100 Then
                If shp.Fill.ForeColor.RGB <> 16777215 Then
                    shp.Fill.ForeColor.RGB = 16777215
                End If
            End If
         
        Else
         
        If shp.Top > 100 Then
            If shp.Fill.ForeColor.RGB <> 16777215 Then
                shp.Fill.ForeColor.RGB = 16777215 '塗りつぶしを無しに
            End If
        End If
         
        End If
         
    Next shp
 
End Sub
 
結論から言うと、シェイプの色外しは、殆ど文字が入っているシェイプに色がついている場合が多く、基本塗り潰しなしと言うよりは、白にするため、そのように修正しました。
また、シェイプに文字が入っておらず、色がついている場合も対応できるよう修正しました。
ちなみに、on error文は、おそらく配置されているシェイプが幾層にもなっており、複雑なためエラーが出ているようでしたので、それを回避するために入れました。
とりあえず、このコードで今のところ、希望に沿う結果が得られているので、これで行こうと思っています。
エクセルの上級者からすると、無駄が多いとお感じになると思いますが、社内でおそらく自分のみの仕様を想定しいるため、希望の結果が得られるのであれば、多少の無駄なコードは問題ありません。
 
＞塗りつぶし色の判定で、5行目以内に該当色があると、作業をやめているが、
6行目以降にあっても、それは残すんですか？そういう意図なら構いませんが、気になりました。
 
シートの上部などに水色でも色を外してはいけないセルなどもあるため、ご指摘のような処理にしてあります。基本、背景色が黄色と水色のセルは色を外すルールなのですが、たまに例外のセルなどもあるため、それはもう人が目視で確認するしか方法がありません。
 
あと、
1)セル内に赤文字以外の文字が混在していても、赤文字のみを黒にしたい。
ですが、一番最初にサンプルとして提示したコードですと、セル内に赤文字しかないセルは、ちゃんと黒に変換されるのですが、黒文字の文章の後に、赤文字がきているような場合のセルは、変換することができませんでした。
ですので、試しに以下のようなコードを作成してみました。
 
Sub 赤文字変更テスト()
 
Dim Rng As Range
Dim ChrNum As Integer, I As Integer
 
For Each Rng In Cells
    If Not Rng.HasFormula Then
        If TypeName(Rng.Value) = "String" Then
            ChrNum = Rng.characters.Count
            If ChrNum <> 0 Then
                For I = 1 To ChrNum
                    If Rng.characters(I, 1).Font.Color = vbRed Then
                        Rng.characters(I, 1).Font.Color = vbBlack
                    End If
                Next I
            End If
        End If
    End If
Next Rng
 
End Sub
 
赤文字が混在しているセルは、もしかすると一つ一つ調べていくしかないのかなと思い、このようなコードにしてみました。
ただ、全セルを調べているので、ブックによっては、数が知れているシェイプを含んだブックよりは時間がかかってしまうため、選択したセルだけを処理する、アドインを作って対応しようかとも考えています。
この件に関して、もしなにかもっといいコードの書き方があれば是非教えていただければと思います。
 
今回、シェイプに関してご提示いただいたコードが非常に参考になり、大変助かりました。
処理しなければならないブックが200とか300とかあることもあるため、とても効率が上がります。
本当に、有難うございました。
また、なにか疑問に思う時があれば是非御教授いただければと思いますので、宜しくお願い致します。