test

Option Explicit

Sub Macro1()
'
' Macro1 Macro
    
    Dim searchText As String        ' 検索文字列
    Dim replaceText As String       ' 置換文字列
    Dim startRow As Long            ' 検索／置換文字列が記載されている先頭行
    startRow = 4
    Dim searchColumn As Long        ' 検索文字列が記載されている列
    searchColumn = 2
    Dim replaceColumn As Long       ' 置換文字列が記載されている列
    replaceColumn = 3
    Dim i As Long                   ' 添え字
    Dim baseBook As Workbook        ' マクロが記載されているブック
    Set baseBook = ThisWorkbook
    Dim targetBook As Workbook      ' 置換を実行するブック
    Dim targetSheet As Worksheet    ' 置換を実行するシート
    
    '対象ファイルを開く
    Set targetBook = Workbooks.Open("C:\test\aaa - コピー.xlsx")
    
    '置換対象の数だけ置換
    For i = startRow To Rows.Count
        
        '検索文字列／置換文字列の取得
        searchText = baseBook.ActiveSheet.Cells(i, replaceColumn).Value
        replaceText = baseBook.ActiveSheet.Cells(i, replaceColumn).Value
        
        '検索文字列が空の場合は終了
        If searchText = "" Then
            Exit For
        End If
        
        'セルの値を置換
            ' What          検索文字列
            ' Replacement   置換文字列
            ' LookAt        xlPart  一部が一致するセルを検索
            '               xlWhole 全部が一致するセルを検索
            ' SearchOrder   xlByRows    検索方向を列で指定
            '               xlByColumns 検索方向を行で指定
            ' MatchCase     True    大文字と小文字を区別
            '               False   区別しない(デフォルト)
            ' MatchByte     True    半角と全角を区別する
            '               False   区別しない(デフォルト)
            ' SearchFormat  検索書式
            ' ReplaceFormat 置換書式
        targetBook.ActiveSheet.Cells.Replace What:=searchText, Replacement:=replaceText, LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=True, MatchByte:=False, SearchFormat:=False, ReplaceFormat:=False
        
        '図形内の文字列を置換
        For Each targetSheet In targetBook.Worksheets
            Call replaceOfShapeText(targetSheet.shapes, searchText, replaceText)
        Next
    Next
    
    'ブックが変更されていたら保存する
    If targetBook.Saved = False Then
        targetBook.Save
    End If
    
    'ファイルを閉じる
    targetBook.Close
'
End Sub

' 関数名：図形内の文字列の置換
' 引数１：shapes 図形オブジェクト
' 引数２：searchText 検索文字列
' 引数３：replaceText 置換文字列
'
Sub replaceOfShapeText(ByRef shapes As Object, ByRef searchText As String, ByRef replaceText As String)
 
  Dim ret As Boolean        ' 処理結果
  Dim shape  As shape       ' 図形オブジェクト
  Dim shapeText As String   ' 図形内の文字列
  Dim stratPos As Long      ' 検索の開始位置
  Dim targetPos As Long     ' 検索結果の文字列位置
 
  ' シート内の図形を検索
  For Each shape In shapes
 
    ' グループ化された図形の場合
    If shape.Type = msoGroup Then
      ' 再帰呼び出し
      Call replaceOfShapeText(shape.GroupItems, searchText, replaceText)
 
    ' 図形内に文字列がある場合
    ElseIf shape.TextFrame2.HasText = msoTrue Then
      
      '検索開始位
      stratPos = 1&
      
      ' 図形内の文字列を置換
      Do While (1)
       
        ' 図形内の文字列を取得
        shapeText = shape.TextFrame2.TextRange.Text
 
        ' 図形内の文字列から検索文字列の位置を取得
        targetPos = InStr(stratPos, shapeText, searchText)
 
        ' 検索文字列が見つからない場合は処理終了
        If targetPos = 0& Then
          Exit Do
        End If
 
        ' 検索文字列を置換
        shape.TextFrame.Characters(targetPos, Len(searchText)).Text = replaceText
        
        '検索開始位置を修正
        stratPos = targetPos + Len(replaceText)
      Loop
    End If
  Next
 
End Sub