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 (http://www.vbaexpress.com/forum/member.php?6494-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 (http://www.vbaexpress.com/forum/member.php?8963-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.