Remplacer les polices dans les objets groupés - Powerpoint 365

Question

J'ai essayé de développer une macro qui remplacera toutes les polices dans la présentation avec "Arial". Jusqu'à présent, j'ai réussi à remplacer les polices de caractères pour les zones de texte, les tableaux et SmartArt, mais je n'ai pas pu remplacer les polices dans les objets groupés. Voici le code de référence. quelqu'un peut-il aider s'il vous plait?

Sous TextFonts()

Dim oSl As Slide 
Dim oSh As Shape 
Dim oTbl As Table 
Dim oSmt As SmartArt 
Dim oNode As SmartArtNode 

Dim lRow As Long 
Dim lCol As Long 
Dim sFontName As String 

sFontName = "Arial" 

With ActivePresentation 
    For Each oSl In .Slides 
     For Each oSh In oSl.Shapes 
      With oSh 
       If .HasTextFrame Then 
        If .TextFrame.HasText Then 
         .TextFrame.TextRange.Font.Name = sFontName 
        End If 
       End If 
      End With 
     Next 
    Next 
End With 

For Each oSh In oSl.Shapes 
    If oSh.HasTable Then 
     Set oTbl = oSh.Table 
     For lRow = 1 To oTbl.Rows.Count 
      For lCol = 1 To oTbl.Columns.Count 
       With oTbl.Cell(lRow, lCol).Shape.TextFrame.TextRange 
        .Font.Name = "Arial" 
       End With 
      Next 
     Next 
    ElseIf oSh.HasSmartArt Then 
     For Each oNode In oSh.SmartArt.AllNodes 
      oNode.TextFrame2.TextRange.Font.Name = "Arial" 
     Next 
    End If 
Next 

Suivant OSL End Sub

Answer 1

PSST En supposant est l'objet groupé (vous pouvez boucle facilement à travers toutes les formes et vérifier si elle est une forme groupée ou non Si PSST .type = msoGroup alors .... alors vous pouvez accéder à des formes individuelles par

Dim li As Long 
    Dim oshp As Shape 

    Set oshp = powerpoint.shape 

If oshp.type = msoGroup then 

      For li = 1 To oshp.GroupItems.count 
      ' you can add some code here for finding a particular shape based on certain properties 
      oshp.GroupItems(li).Select 
      if oshp.type=rectangle etc etc 
      Next 

le code mentionné par yo u ci-dessus reste le même. c'est tout simplement une explication vague, mais vous l'obtenir

Answer 2

Code pour remplacer la présentation entière avec la police unique sélectionnée:

Sub TextFonts() 

Dim oSl As Slide 
Dim oSh As Shape 
Dim oTbl As Table 
Dim oSmt As SmartArt 
Dim oNode As SmartArtNode 

Dim lRow As Long 
Dim lCol As Long 
Dim X As Long 
Dim sFontName As String 

sFontName = "Arial" 


'Text Boxes 
With ActivePresentation 
    For Each oSl In .Slides 
     For Each oSh In oSl.Shapes 
      With oSh 
       If .HasTextFrame Then 
        If .TextFrame.HasText Then 
         .TextFrame.TextRange.Font.Name = sFontName 
        End If 
       End If 
      End With 
     Next 
    Next 
End With 

'Grouped Objects 
For Each oSl In ActivePresentation.Slides 
    For Each oSh In oSl.Shapes 
     With oSh 
      Select Case .Type 
      Case Is = msoGroup 
       For X = 1 To .GroupItems.Count 
        If .GroupItems(X).HasTextFrame Then 
         If .GroupItems(X).TextFrame.HasText Then 
           .GroupItems(X).TextFrame.TextRange.Font.Name = sFontName 
         End If 
        End If 
       Next X 
      End Select 
     End With ' oSh 
    Next oSh 
Next oSl 

'Smart Arts 
For Each oSl In ActivePresentation.Slides 
    For Each oSh In oSl.Shapes 
     If oSh.HasTable Then 
      Set oTbl = oSh.Table 
      For lRow = 1 To oTbl.Rows.Count 
       For lCol = 1 To oTbl.Columns.Count 
        With oTbl.Cell(lRow, lCol).Shape.TextFrame.TextRange 
         .Font.Name = sFontName 
        End With 
       Next 
      Next 
     ElseIf oSh.HasSmartArt Then 
      For Each oNode In oSh.SmartArt.AllNodes 
       oNode.TextFrame2.TextRange.Font.Name = sFontName 
      Next 
     End If 
    Next 
Next oSl 

End Sub