Leonardoが投稿したコードは単純で一般的に効果的ですがShape
、グループ内のsには影響しません。より一般的なコードでは、再帰を使用してそのケースも処理します(Leonardoによるコードと同じスレッドにある、ここから少し変更されています)。
Private Function ChangeLangOfAllText_caller()
'ChangeLangOfAllText (msoLanguageIDEnglishUS)
ChangeLangOfAllText (msoLanguageIDSpanishArgentina)
End Function
Private Function ChangeLangOfAllText(ByVal LangID As Long)
Dim MySlide As Slide
Dim MyShape As Shape
Dim MyD As Design
Dim MyHeaderFooter As HeaderFooter
Dim i, nbs As Integer
''''' First deal with the master slides
For Each MyD In ActivePresentation.Designs
For Each MyShape In MyD.SlideMaster.Shapes
ProcessShapes MyShape, LangID
Next MyShape
Next MyD
''''' Now deal with the slides
' Enable this for debugging
'Debug.Print "File " & ActivePresentation.Name & _
": working with " & ActivePresentation.Slides.Count & " slides"
For Each MySlide In ActivePresentation.Slides
' Enable this for debugging
'Debug.Print " Slide index " & MySlide.SlideIndex & ", Slide number " & MySlide.SlideNumber & _
": working with " & MySlide.Shapes.Count & " shapes"
For Each MyShape In MySlide.Shapes
ProcessShapes MyShape, LangID
Next MyShape
''''' Now deal with the Notes
For Each MyShape In MySlide.NotesPage.Shapes
ProcessShapes MyShape, LangID
Next MyShape
''''' Now deal with the master ' doesn't appear to work, have to try something else
For Each MyShape In MySlide.Master.Shapes
ProcessShapes MyShape, LangID
Next MyShape
Next MySlide
End Function
Private Function ProcessShapes(MyShape As Shape, ByVal LangID As Long)
Dim i As Integer
If ((MyShape.Type = msoGroup) Or (MyShape.Type = msoTable)) Then
On Error Resume Next
For i = 1 To MyShape.GroupItems.Count
''' The trick is to recurse!
ProcessShapes MyShape.GroupItems.Item(i), LangID
Next i
Else
ChangeLang MyShape, LangID
End If
End Function
Private Function ChangeLang(MyShape As Shape, ByVal LangID As Long)
Dim i As Integer
If (MyShape.HasTextFrame) Then
' Enable this for debugging
'Debug.Print " Shape " & MyShape.ZOrderPosition & ", type: " & MyShape.Type & _
", has text frame: " & MyShape.HasTextFrame & ", has text: " & MyShape.TextFrame.HasText & _
", alt. text: " & MyShape.AlternativeText
MyShape.TextFrame.TextRange.LanguageID = LangID
End If
End Function