そこからですか。では、もう一度修正コードを全部。
●Excelのワークシートに 置換前 置換後 を下のように並べておいて
A B
1 原油 石油
2 空白 白
3 生命 生活
●ExcelでAlt+F11→挿入→標準モジュールに以下を貼り付け
Dim myArr As Variant
Dim VBReg As Object
Dim Matches As Object
Sub Chikann2()
Dim cntRow As Long
Dim myRng As Range
Dim objPPT As Object 'PowerPoint.Application
Dim myPre As Object 'PowerPoint.Presentation
Dim Sld As Object 'PowerPoint.Slide
Dim Shp As Object 'PowerPoint.Shape
Dim myRow As Object 'PowerPoint.Row
Dim myCell As Object 'PowerPoint.Cell
Dim iShp As Object 'PowerPoint.Shape
'A,B列の置換パターン配列に
cntRow = Range("A" & Rows.Count).End(xlUp).Row
Set myRng = Range("A1:B" & cntRow)
myArr = myRng.Value
'パワポ起動
On Error GoTo Mikidou
Set objPPT = GetObject(, "PowerPoint.Application")
With objPPT
.Activate
Set myPre = .ActivePresentation
End With
On Error GoTo 0
Set VBReg = CreateObject("VBScript.RegExp")
'図形ループ
For Each Sld In myPre.Slides
For Each Shp In Sld.Shapes
With Shp
' 普通のオブジェクトの場合
If .HasTextFrame Then
Hennkann .TextFrame.TextRange
' 表の場合
ElseIf .HasTable Then
For Each myRow In .Table.Rows
For Each myCell In myRow.Cells
Hennkann myCell.Shape.TextFrame.TextRange
Next
Next
' グループオブジェクトの場合
ElseIf .Type = msoGroup Then
For Each iShp In .GroupItems
With iShp
If .HasTextFrame Then
Hennkann .TextFrame.TextRange
End If
End With
Next
End If
End With
Next
Next
Set iShp = Nothing
Set myCell = Nothing
Set myRow = Nothing
Set Shp = Nothing
Set Sld = Nothing
Set myPre = Nothing
Set objPPT = Nothing
Set Matches = Nothing
Set VBReg = Nothing
Exit Sub
Mikidou: MsgBox "パワポファイル開いといて"
End Sub
Sub Hennkann(txtRng As Object) 'PowerPoint.TextRange
Dim i As Long
Dim m As Integer
Dim j As Integer
Dim txtRng2 As Object 'PowerPoint.TextRange
If txtRng.Text <> "" Then
'渡されたTextRangeの中から検索置換
For i = 1 To UBound(myArr, 1)
If Len(myArr(i, 1)) > 0 Then
With VBReg
.Pattern = myArr(i, 1)
.IgnoreCase = False
.Global = True
If .test(txtRng.Text) Then
For m = 1 To txtRng.Paragraphs.Count
Set txtRng2 = txtRng.Paragraphs(m)
If .test(txtRng2.Text) Then
Set Matches = .Execute(txtRng2.Text)
For j = Matches.Count - 1 To 0 Step -1
With Matches(j)
With txtRng2.Characters(.FirstIndex + 1, .Length)
.Text = VBReg.Replace(.Text, myArr(i, 2))
End With
End With
Next j
End If
Next m
End If
End With
End If
Next i
End If
End Sub
お礼
すみません、そんなレベルなんです…。 回答本当にありがとうございました! 貼り付けてみたらできて、涙ものの大感動でしたっ!! エクセルの置き換えマクロも手入力の置き換えを 自動で記録したレベルなんです。 まだまだ、お聞きしたいことがあるのですが、よかったら回答をお願いできないでしょうか? AとB行に置き換えたい文字を入れたデータファイルは作りました。 しかし、そのファイルには3枚シートがあり、そのうちの1枚が文字データ表になります。 そのシートを指定することはできますでしょうか? また、同シートを使って、エクセルで他のエクセルファイル内を 一括で置き換えるVBAもあるのでしょうか? さらに、同様にそのエクセル置き換えデータを使用した ワードのファイルも一括で置き換えはできるのでしょうか? 現在、ワードも手入力で置き換えしたものを自動で記録したマクロを使用しています。 たくさんの質問で申し訳ありません。 ぜひともよろしくお願いします。