repeat code

[baset]

Dear All

I've some code (macro) that run on normal text boxes; how can i make it run all shapes types like Tables, Groups, Diagrams....etc.

like that:

Sub NoName() 'Edit: added this line for code tags
Dim regX As Object
    Dim osld As Slide
    Dim oshp As Shape
    Dim L As Long
    Dim strInput As String
    Dim b_found As Boolean
    
    On Error Resume Next
    
For Each osld In ActivePresentation.Slides

For Each oshp In osld.Shapes
            If oshp.HasTextFrame Then
               With oshp.TextFrame.TextRange
                     
                     .Font.Name = "Arial"
                     .Font.NameComplexScript = "Arial"
                     .ParagraphFormat.TextDirection = ppDirectionRightToLeft
                     .RtlRun
                     
                        If oshp.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignLeft Then
                           oshp.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignRight
                        End If

 End With
             End If
        Next oshp



For Each oshp In osld.NotesPage.Shapes
            If oshp.HasTextFrame Then
               With oshp.TextFrame.TextRange
                     
                     .Font.Name = "Arial"
                     .Font.NameComplexScript = "Arial"
                     .ParagraphFormat.TextDirection = ppDirectionRightToLeft
                     .RtlRun
                     
                        If oshp.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignLeft Then
                           oshp.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignRight
                        End If
End With
             End If
        Next oshp

Next osld
    
     
End Sub

[SamT]

I don't know if this will help, but check out this code structure.

First replace the loops in your code with

 
 For Each osld In ActivePresentation.Slides
         
        For Each oshp In osld.Shapes
          FormatShape oshp
        Next oshp
         
        For Each oshp In osld.NotesPage.Shapes
          FormatShape oshp
        Next oshp
         
    Next osld

Then add this Procedure

Private Sub FormatShape(Shp As Shape)
  If oshp.HasTextFrame Then
      With oshp.TextFrame.TextRange
           
          .Font.Name = "Arial"
          .Font.NameComplexScript = "Arial"
          .ParagraphFormat.TextDirection = ppDirectionRightToLeft
          .RtlRun
           
          If oshp.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignLeft Then
              oshp.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignRight
          End If
           
      End With
  End If

End Sub

[John Wilson]

Here's how to do Tables and Groups. You will have to search a little on Google to do Diagrams etc in a similar way. It's untested from the top of my head so you may need to check it.

Sub NoName()      'Edit: added this line for code tags

   Dim osld As Slide
   Dim oshp As Shape
   Dim L As Long
   On Error Resume Next
   For Each osld In ActivePresentation.Slides
      For Each oshp In osld.Shapes
         'Table?
         If oshp.HasTable Then
            Call r2LTable(oshp.Table)
         End If
         If oshp.Type = msoGroup Then
            Call r2LGroup(oshp)
         End If
         'shapes,placehoders,textboxes etc
         If oshp.HasTextFrame Then
            With oshp.TextFrame.TextRange
               .Font.Name = "Arial"
               .Font.NameComplexScript = "Arial"
               .ParagraphFormat.TextDirection = ppDirectionRightToLeft
               .RtlRun
            End With
            If oshp.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignLeft Then
               oshp.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignRight
            End If
         End If
      Next oshp
      'notes pages
      For Each oshp In osld.NotesPage.Shapes
         If oshp.HasTextFrame Then
            With oshp.TextFrame.TextRange
               .Font.Name = "Arial"
               .Font.NameComplexScript = "Arial"
               .ParagraphFormat.TextDirection = ppDirectionRightToLeft
               .RtlRun
               If .ParagraphFormat.Alignment = ppAlignLeft Then
                  .ParagraphFormat.Alignment = ppAlignRight
               End If
            End With
         End If
      Next oshp
   Next osld
End Sub

Sub r2LTable(otbl As Table)
   Dim iRow As Integer
   Dim iCol As Integer
   For iRow = 1 To otbl.Rows.Count
      For iCol = 1 To otbl.Columns.Count
         With otbl.Cell(iRow, iCol).Shape.TextFrame.TextRange
            .Font.Name = "Arial"
            .Font.NameComplexScript = "Arial"
            .ParagraphFormat.TextDirection = ppDirectionRightToLeft
            .RtlRun
            If .ParagraphFormat.Alignment = ppAlignLeft Then
               .ParagraphFormat.Alignment = ppAlignRight
            End If
         End With
      Next iCol
   Next iRow
End Sub

Sub r2LGroup(ogrp As Shape)
   Dim iCount As Integer
   For iCount = 1 To ogrp.GroupItems.Count
      If ogrp.GroupItems(iCount).HasTextFrame Then
         With ogrp.GroupItems(iCount).TextFrame.TextRange


            .Font.Name = "Arial"
            .Font.NameComplexScript = "Arial"
            .ParagraphFormat.TextDirection = ppDirectionRightToLeft
            .RtlRun
            If .ParagraphFormat.Alignment = ppAlignLeft Then
               .ParagraphFormat.Alignment = ppAlignRight
            End If
         End With
      End If
   Next iCount
End Sub

[baset]

Thanks "SamT" for this perfect organized code; but still it's missing an important part which how can make this run also for "msoTable, msoGroup, msoDiagram" ?

[baset]

Thanks "John Wilson" for trying to help here but i see that the format shape commands are still repeated for each shape type; i need to put them on a function or private macro then call it for every shape type ?

[SamT]

format shape commands are still repeated for each shape type; i need to put them on a function or private macro then call it for every shape type

Your choice. I would just to keep the different subs short and concise. Why write the same code over and over again?

[baset]

Your choice. I would just to keep the different subs short and concise. Why write the same code over and over again?

Sorry same i think you mixed my 2 replies, this quote was for John, but for you master there is no repeated code but i need an addtional help from you on how i used the formatshap private macro for other shape types like tables & groups for example ?

[SamT]

I reformatted John's code, go look at it again.

Sorry same_(sic) i think you mixed my 2 replies, this quote was for John

If you do not want one of us to help you with code from another one of us that we did not personally write, please say so and we will not help you to understand any post that we did not personally write.

i need an addtional help from you on how i used the formatshap private macro for other shape types like tables & groups for example

You can't, they need their own Procedures. See John's code. Again.

[baset]

Mr. SamT i'm sorry if you goes angry from me, i think i can't be able to deliver my idea to you cuz my bad english but kindly note that you all helped me too much, sorry again for mis understanding.

[SamT]

I understand what you are saying. Your English is that good,

I can not assist your English. All your questions have been answered by John and myself.

You will need to carefully read the English and you will understand all.

[John Wilson]

I was avoiding writing concise code because I can tell you are not an expert PowerPoint coder baset and I thought it would confuse you. Running the code in a function is definitely a good idea but it actually will not run a lot faster because each oshp can only call one of the modules. It is not that simple to write in function referring to oshp because (for example) if it is a table it will NOT have a textframe)


For reference Try:

Sub R2L()      'Edit: added this line for code tags   Dim iRow As Integer
   Dim iCol As Integer
   Dim otr As TextRange
   Dim osld As Slide
   Dim oshp As Shape
   Dim otbl As Table
   Dim L As Long
   On Error Resume Next
   For Each osld In ActivePresentation.Slides
      For Each oshp In osld.Shapes
         'Table?
         If oshp.HasTable Then
            Set otbl = oshp.Table
            For iRow = 1 To otbl.Rows.Count
               For iCol = 1 To otbl.Columns.Count
                  Set otr = otbl.Cell(iRow, iCol).Shape.TextFrame.TextRange
                  Set otr = fixtr(otr)
               Next iCol
            Next iRow
         End If
         'group
         If oshp.Type = msoGroup Then
            For L = 1 To oshp.GroupItems.Count
               If oshp.GroupItems(L).HasTextFrame Then
                  Set otr = oshp.GroupItems(L).TextFrame.TextRange
                  Set otr = fixtr(otr)
               End If
            Next L
         End If
         'shapes,placehoders,textboxes etc
         If oshp.HasTextFrame Then
            Set otr = oshp.TextFrame.TextRange
            Set otr = fixtr(otr)
         End If
      Next oshp
      'notes pages
      For Each oshp In osld.NotesPage.Shapes
         If oshp.HasTextFrame Then
            Set otr = oshp.TextFrame.TextRange
            Set otr = fixtr(otr)
         End If
      Next oshp
   Next osld
End Sub


Function fixtr(otrIn As TextRange) As TextRange
   With otrIn
      .Font.Name = "Arial"
      .Font.NameComplexScript = "Arial"
      .ParagraphFormat.TextDirection = ppDirectionRightToLeft
      .RtlRun
      'note this will not change any other alignment
      If .ParagraphFormat.Alignment = ppAlignLeft Then
         .ParagraphFormat.Alignment = ppAlignRight
      End If
   End With
End Function

PS msoDiagram?? - are you using an old version of PowerPoint?

[baset]

Thank you both SamT and Jhon for helping me too much; I'll test these codes then get back to you for any query.

[John Wilson]

Don't forget to say what version you have.

[baset]

Don't forget to say what version you have.

I'm using Office 2013 version.