Option Explicit Public Sub CSharpのキーワードの色を変更する() Dim keywordList() As String keywordList = Split("テキスト", ",") Dim keywordColor As Long keywordColor = RGB(0, 0, 255) Dim backGroundColor As Long backGroundColor = RGB(128, 0, 128) Call DeleteShapesWithName("AutoInserted") Dim i As Integer For i = LBound(keywordList) To UBound(keywordList) Call FindAndChangeColor(keywordList(i), keywordColor, backGroundColor) Next End Sub Sub DeleteShapesWithName(ByVal targetName As String) Dim sld As Slide Dim shp As Shape Dim i As Long i = 1 For Each sld In Application.ActivePresentation.Slides Do Until i > sld.Shapes.Count If sld.Shapes(i).name = targetName Then sld.Shapes(i).Delete Else i = i + 1 End If Loop Next End Sub Sub FindAndChangeColor(ByVal keyword As String, ByVal newColor As Long, ByVal newBackGroundColor As Long) Dim sld As Slide Dim shp As Shape Dim txtRng As TextRange Dim foundText As TextRange Dim foundShape As Shape For Each sld In Application.ActivePresentation.Slides For Each shp In sld.Shapes If shp.HasTextFrame Then Set txtRng = shp.TextFrame.TextRange Set foundText = txtRng.Find(FindWhat:=keyword) Do While Not (foundText Is Nothing) Set foundShape = sld.Shapes.AddShape( _ msoShapeRectangle, _ foundText.BoundLeft, _ foundText.BoundTop, _ foundText.BoundWidth, _ foundText.BoundHeight) foundShape.Fill.ForeColor.RGB = newBackGroundColor foundShape.Fill.Transparency = 0.8 foundShape.name = "AutoInserted" foundShape.Line.Visible = msoFalse With foundText .Font.Color.RGB = newColor Set foundText = _ txtRng.Find(FindWhat:=keyword, _ After:=.Start + .Length - 1) End With Loop End If Next Next End Sub