Revisions to How do I change the language of all Powerpoint slides at once?

Fix variable j being (unintentionally) typed as Variant and change Integer to Long because Integer is scaringly small in VBA (32767) and could be exceeded by complex presentations

Source Link

edit approved Nov 21, 2018 at 7:27

Marcus Mangelsdorf

1.3k
2
12
20

I improved upon Inigo's answer to provide a recursive version that changes all items to the desired language.

This version will recursively investigate each shape that is a group type. Some experimentation suggests that msoGroup and msoSmartArt are the group types - feel free to add to that list if you find other types of shapes that can hold text objects.

Sub ChangeProofingLanguageToEnglish()
    Dim j As Long, k As IntegerLong
    Dim languageID As MsoLanguageID
    
    'Set this to your preferred language
    languageID = msoLanguageIDEnglishUK
    
    For j = 1 To ActivePresentation.Slides.Count
        For k = 1 To ActivePresentation.Slides(j).Shapes.Count
            ChangeAllSubShapes ActivePresentation.Slides(j).Shapes(k), _
              languageID
        Next k
    Next j
End Sub


Sub ChangeAllSubShapes(targetShape As shape, languageID As MsoLanguageID)
    Dim i As IntegerLong
    
    If targetShape.HasTextFrame Then
        targetShape.TextFrame.TextRange.languageID = languageID
    End If
    
    Select Case targetShape.Type
        Case msoGroup, msoSmartArt
            For i = 1 To targetShape.GroupItems.Count
                ChangeAllSubShapes targetShape.GroupItems.Item(i), languageID
            Next i
    End Select
End Sub

I improved upon Inigo's answer to provide a recursive version that changes all items to the desired language.

This version will recursively investigate each shape that is a group type. Some experimentation suggests that msoGroup and msoSmartArt are the group types - feel free to add to that list if you find other types of shapes can hold text objects.

Sub ChangeProofingLanguageToEnglish()
    Dim j, k As Integer
    Dim languageID As MsoLanguageID
    
    'Set this to your preferred language
    languageID = msoLanguageIDEnglishUK
    
    For j = 1 To ActivePresentation.Slides.Count
        For k = 1 To ActivePresentation.Slides(j).Shapes.Count
            ChangeAllSubShapes ActivePresentation.Slides(j).Shapes(k), _
              languageID
        Next k
    Next j
End Sub


Sub ChangeAllSubShapes(targetShape As shape, languageID As MsoLanguageID)
    Dim i As Integer
    
    If targetShape.HasTextFrame Then
        targetShape.TextFrame.TextRange.languageID = languageID
    End If
    
    Select Case targetShape.Type
        Case msoGroup, msoSmartArt
            For i = 1 To targetShape.GroupItems.Count
                ChangeAllSubShapes targetShape.GroupItems.Item(i), languageID
            Next i
    End Select
End Sub

I improved upon Inigo's answer to provide a recursive version that changes all items to the desired language.

This version will recursively investigate each shape that is a group type. Some experimentation suggests that msoGroup and msoSmartArt are the group types - feel free to add to that list if you find other types of shapes that can hold text objects.

Sub ChangeProofingLanguageToEnglish()
    Dim j As Long, k As Long
    Dim languageID As MsoLanguageID
    
    'Set this to your preferred language
    languageID = msoLanguageIDEnglishUK
    
    For j = 1 To ActivePresentation.Slides.Count
        For k = 1 To ActivePresentation.Slides(j).Shapes.Count
            ChangeAllSubShapes ActivePresentation.Slides(j).Shapes(k), _
              languageID
        Next k
    Next j
End Sub


Sub ChangeAllSubShapes(targetShape As shape, languageID As MsoLanguageID)
    Dim i As Long
    
    If targetShape.HasTextFrame Then
        targetShape.TextFrame.TextRange.languageID = languageID
    End If
    
    Select Case targetShape.Type
        Case msoGroup, msoSmartArt
            For i = 1 To targetShape.GroupItems.Count
                ChangeAllSubShapes targetShape.GroupItems.Item(i), languageID
            Next i
    End Select
End Sub

replaced http://superuser.com/ with https://superuser.com/

Source Link

edited Mar 20, 2017 at 10:17

Community Bot

1

I improved upon Inigo's answer Inigo's answer to provide a recursive version that changes all items to the desired language.

This version will recursively investigate each shape that is a group type. Some experimentation suggests that msoGroup and msoSmartArt are the group types - feel free to add to that list if you find other types of shapes can hold text objects.

Sub ChangeProofingLanguageToEnglish()
    Dim j, k As Integer
    Dim languageID As MsoLanguageID
    
    'Set this to your preferred language
    languageID = msoLanguageIDEnglishUK
    
    For j = 1 To ActivePresentation.Slides.Count
        For k = 1 To ActivePresentation.Slides(j).Shapes.Count
            ChangeAllSubShapes ActivePresentation.Slides(j).Shapes(k), _
              languageID
        Next k
    Next j
End Sub


Sub ChangeAllSubShapes(targetShape As shape, languageID As MsoLanguageID)
    Dim i As Integer
    
    If targetShape.HasTextFrame Then
        targetShape.TextFrame.TextRange.languageID = languageID
    End If
    
    Select Case targetShape.Type
        Case msoGroup, msoSmartArt
            For i = 1 To targetShape.GroupItems.Count
                ChangeAllSubShapes targetShape.GroupItems.Item(i), languageID
            Next i
    End Select
End Sub

I improved upon Inigo's answer to provide a recursive version that changes all items to the desired language.

This version will recursively investigate each shape that is a group type. Some experimentation suggests that msoGroup and msoSmartArt are the group types - feel free to add to that list if you find other types of shapes can hold text objects.

Sub ChangeProofingLanguageToEnglish()
    Dim j, k As Integer
    Dim languageID As MsoLanguageID
    
    'Set this to your preferred language
    languageID = msoLanguageIDEnglishUK
    
    For j = 1 To ActivePresentation.Slides.Count
        For k = 1 To ActivePresentation.Slides(j).Shapes.Count
            ChangeAllSubShapes ActivePresentation.Slides(j).Shapes(k), _
              languageID
        Next k
    Next j
End Sub


Sub ChangeAllSubShapes(targetShape As shape, languageID As MsoLanguageID)
    Dim i As Integer
    
    If targetShape.HasTextFrame Then
        targetShape.TextFrame.TextRange.languageID = languageID
    End If
    
    Select Case targetShape.Type
        Case msoGroup, msoSmartArt
            For i = 1 To targetShape.GroupItems.Count
                ChangeAllSubShapes targetShape.GroupItems.Item(i), languageID
            Next i
    End Select
End Sub

I improved upon Inigo's answer to provide a recursive version that changes all items to the desired language.

This version will recursively investigate each shape that is a group type. Some experimentation suggests that msoGroup and msoSmartArt are the group types - feel free to add to that list if you find other types of shapes can hold text objects.

Sub ChangeProofingLanguageToEnglish()
    Dim j, k As Integer
    Dim languageID As MsoLanguageID
    
    'Set this to your preferred language
    languageID = msoLanguageIDEnglishUK
    
    For j = 1 To ActivePresentation.Slides.Count
        For k = 1 To ActivePresentation.Slides(j).Shapes.Count
            ChangeAllSubShapes ActivePresentation.Slides(j).Shapes(k), _
              languageID
        Next k
    Next j
End Sub


Sub ChangeAllSubShapes(targetShape As shape, languageID As MsoLanguageID)
    Dim i As Integer
    
    If targetShape.HasTextFrame Then
        targetShape.TextFrame.TextRange.languageID = languageID
    End If
    
    Select Case targetShape.Type
        Case msoGroup, msoSmartArt
            For i = 1 To targetShape.GroupItems.Count
                ChangeAllSubShapes targetShape.GroupItems.Item(i), languageID
            Next i
    End Select
End Sub

added 30 characters in body

Source Link

edited Jul 3, 2014 at 11:09

Duncan Jones

712
1
10
26

Sub ChangeProofingLanguageToEnglish()
    Dim j, k As Integer
    Dim languageID As MsoLanguageID
    
    'Set this to your preferred language
    languageID = msoLanguageIDEnglishUK
    
    For j = 1 To ActivePresentation.Slides.Count
        For k = 1 To ActivePresentation.Slides(j).Shapes.Count
            ChangeAllSubShapes ActivePresentation.Slides(j).Shapes(k), _
              languageID
        Next k
    Next j
End Sub


Sub ChangeAllSubShapes(targetShape As shape, languageID As MsoLanguageID)
    Dim i As Integer
    
    If targetShape.HasTextFrame Then
        targetShape.TextFrame.TextRange.languageID = languageID
    End If
    
    Select Case targetShape.Type
        Case msoGroup, msoSmartArt
            For i = 1 To targetShape.GroupItems.Count
                ChangeAllSubShapes targetShape.GroupItems.Item(i), languageID
            Next i
    End Select
End Sub

Sub ChangeProofingLanguageToEnglish()
    Dim j, k As Integer
    Dim languageID As MsoLanguageID
    
    'Set this to your preferred language
    languageID = msoLanguageIDEnglishUK
    
    For j = 1 To ActivePresentation.Slides.Count
        For k = 1 To ActivePresentation.Slides(j).Shapes.Count
            ChangeAllSubShapes ActivePresentation.Slides(j).Shapes(k), _
              languageID
        Next k
    Next j
End Sub


Sub ChangeAllSubShapes(targetShape As shape, languageID As MsoLanguageID)
    Dim i As Integer
    
    If targetShape.HasTextFrame Then
        targetShape.TextFrame.TextRange.languageID = languageID
    End If
    
    Select Case targetShape.Type
        Case msoGroup, msoSmartArt
            For i = 1 To targetShape.GroupItems.Count
                ChangeAllSubShapes targetShape.GroupItems.Item(i), languageID
            Next i
    End Select
End Sub

Sub ChangeProofingLanguageToEnglish()
    Dim j, k As Integer
    Dim languageID As MsoLanguageID
    
    'Set this to your preferred language
    languageID = msoLanguageIDEnglishUK
    
    For j = 1 To ActivePresentation.Slides.Count
        For k = 1 To ActivePresentation.Slides(j).Shapes.Count
            ChangeAllSubShapes ActivePresentation.Slides(j).Shapes(k), _
              languageID
        Next k
    Next j
End Sub


Sub ChangeAllSubShapes(targetShape As shape, languageID As MsoLanguageID)
    Dim i As Integer
    
    If targetShape.HasTextFrame Then
        targetShape.TextFrame.TextRange.languageID = languageID
    End If
    
    Select Case targetShape.Type
        Case msoGroup, msoSmartArt
            For i = 1 To targetShape.GroupItems.Count
                ChangeAllSubShapes targetShape.GroupItems.Item(i), languageID
            Next i
    End Select
End Sub

Sub ChangeProofingLanguageToEnglish()
    Dim j, k As Integer
    Dim languageID As MsoLanguageID
    
    'Set this to your preferred language
    languageID = msoLanguageIDEnglishUK
    
    For j = 1 To ActivePresentation.Slides.Count
        For k = 1 To ActivePresentation.Slides(j).Shapes.Count
            ChangeAllSubShapes ActivePresentation.Slides(j).Shapes(k), _
              languageID
        Next k
    Next j
End Sub


Sub ChangeAllSubShapes(targetShape As shape, languageID As MsoLanguageID)
    Dim i As Integer
    
    If targetShape.HasTextFrame Then
        targetShape.TextFrame.TextRange.languageID = languageID
    End If
    
    Select Case targetShape.Type
        Case msoGroup, msoSmartArt
            For i = 1 To targetShape.GroupItems.Count
                ChangeAllSubShapes targetShape.GroupItems.Item(i), languageID
            Next i
    End Select
End Sub

In the first loop use languageID instead of msoLanguageIDEnglishUK, otherwise defining this variable doesn't really have an effect, right?

Source Link

edit approved May 22, 2014 at 12:50

Community Bot

1

Loading

added 4 characters in body

Source Link

edited Feb 3, 2014 at 16:32

Duncan Jones

712
1
10
26

Loading

Source Link

created Nov 25, 2013 at 9:52

Duncan Jones

712
1
10
26

Loading

Stack Exchange Network

Return to Answer