Consulting

Results 1 to 19 of 19

Thread: Select English text only

  1. #1
    VBAX Regular
    Joined
    Dec 2015
    Posts
    69
    Location

    Post Select English text only

    How can i select only the english words and spaces between them and give them a different color.

    Example:
    Microsoft Lumia 950 XL هو الهاتف الذكي الأمثل الذي يتميز بشاشة QuadHD مقاس 5.7 بوصات، مع
    Select:
    Microsoft Lumia 950 XL & QuadHD

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    1,880
    Location
    Does this code work for you?

    Sub chexUAE()
    Dim oshp As Shape
    Dim osld As Slide
    Dim otr As TextRange
    Dim L As Long
    For Each osld In ActivePresentation.Slides
    For Each oshp In osld.Shapes
    If oshp.HasTextFrame Then
    If oshp.TextFrame.HasText Then
    With oshp.TextFrame.TextRange
    For L = 1 To .Runs.Count
    Set otr = .Runs(L)
    If otr.LanguageID <> msoLanguageIDArabicUAE Then
    otr.Font.Color.RGB = vbRed
    Else
    otr.Font.Color.RGB = vbBlack
    End If
    Next L
    End With
    End If
    End If
    Next oshp
    Next osld
    End Sub
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3
    VBAX Regular
    Joined
    Dec 2015
    Posts
    69
    Location
    Thanks sir for offering help here; kindly note that i'm not making any selection according to the LanguageID as all text boxes have the same LanguageID (msoLanguageIDArabicEgypt) so i need a macro to go to every text box on every slide and search for any english character then select it then go next character; if it's space also select it if it's english character or number continue selection till he found first un-english character (arabic) then stop selection and after selecting this rang it should be given LtrRun or msoLanguageIDEnglishUS

    Sample file is attached.
    Attached Files Attached Files

  4. #4
    Moderator VBAX Wizard SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    6,979
    Location
    You can try
    If AscW(Character) < 128 Then 'English Character
    See "Character Set" in the VBA Help. You can also try < 256 which will catch some other latin characters and common symbols.

    See also: http://www.unicode.org/charts/

    To insert Arabic Characters, use ChrW
    X = ChrW(610) & ChrW(611) & Chrw(612)
    I mean no insult, I do not know what the Arabic Characters represented by those three random numbers mean.
    I always expect the student to do their homework and find all the errrors I leeve in.

    Please take the time to read the Forum FAQ

  5. #5
    VBAX Master
    Joined
    Feb 2007
    Posts
    1,880
    Location
    The original sample did have the languages set to UK and UAE but the second was all the same.

    As Sam suggests I think the only way would be to check each character which will run slowly.

    This would probably work

    Sub chexArabic()
    
    Dim L As Long
    Dim oshp As Shape
    Dim osld As Slide
    For Each osld In ActivePresentation.Slides
    For Each oshp In osld.Shapes
    If oshp.HasTextFrame Then
    If oshp.TextFrame.HasText Then
    With oshp.TextFrame.TextRange
    For L = 1 To .Characters.Count
    If AscW(.Characters(L)) < 256 Then .Characters(L).Font.Color = vbRed
    Next L
    End With
    End If
    End If
    Next oshp
    Next osld
    End Sub
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  6. #6
    VBAX Regular
    Joined
    Dec 2015
    Posts
    69
    Location
    Thanks for all trying to help here and sorry for any confusion; Let's simplify the request:

    I need to select any text range that start and end with any English character or number ?

  7. #7
    VBAX Master
    Joined
    Feb 2007
    Posts
    1,880
    Location
    I'm pretty sure that would be impossible (well at least very difficult). If you just need to change the colour there is no need to select anyway.
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  8. #8
    VBAX Regular
    Joined
    Dec 2015
    Posts
    69
    Location
    Now i can changed the color and languageID for all english characters and numbers; how can i select only space between 2 red characters or between 2 characters that have LanguageIdEnglishUS ?

  9. #9
    VBAX Regular
    Joined
    Dec 2015
    Posts
    69
    Location
    this is the code i reached so far with the latest example:

    For Each sld In ActivePresentation.Slides
    For Each shp In sld.Shapes
    If shp.HasTextFrame Then
    If shp.TextFrame.HasText Then
    With shp.TextFrame.TextRange
    For L = 1 To .Characters.Count
    If AscW(.Characters(L)) >= 48 And AscW(.Characters(L)) <= 57 Then '0-9
    .Characters(L).Font.Color = vbRed
    .Characters(L).LanguageID = msoLanguageIDEnglishUS
    End If
    If AscW(.Characters(L)) >= 65 And AscW(.Characters(L)) <= 90 Then 'A-Z
    .Characters(L).Font.Color = vbRed
    .Characters(L).LanguageID = msoLanguageIDEnglishUS
    End If
    If AscW(.Characters(L)) >= 97 And AscW(.Characters(L)) <= 122 Then 'a-z
    .Characters(L).Font.Color = vbRed
    .Characters(L).LanguageID = msoLanguageIDEnglishUS
    End If
    If AscW(.Characters(L)) = 174 Or AscW(.Characters(L)) = 8482 Then '
    .Characters(L).Font.Color = vbRed
    .Characters(L).LanguageID = msoLanguageIDEnglishUS
    End If
    Next L
    End With
    End If
    End If
    Next shp
    Next sld
    Attached Files Attached Files

  10. #10
    Moderator VBAX Wizard SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    6,979
    Location
    This will be much faster than so many If...Then's. A Select Case ends when any match is found. Checking only for "Less Than" is twice as fast as checking for "between"
    For L = 1 To .Characters.Count
    Select Case AscW(.Characters(L))
    Case  < 48 'do nothing
    Case < 58 '0-9
    With .Characters(L)
    .Font.Color = vbRed
    .LanguageID = msoLanguageIDEnglishUS
    End With
    Case < 65 'do nothing
    Case < 91  'A-Z
    With .Characters(L)
    .Font.Color = vbRed
    .LanguageID = msoLanguageIDEnglishUS
    End With
    Case < 97 'do nothing
    Case  < 123 'a-z
    With .Characters(L)
    .Font.Color = vbRed
    .LanguageID = msoLanguageIDEnglishUS
    End With
    Case <173 'do nothing
    Case 173 ' 
    With .Characters(L)
    .Font.Color = vbRed
    .LanguageID = msoLanguageIDEnglishUS
    End With
    Case < 8482 'do nothing
    Case  8482 '™
    With .Characters(L)
    .Font.Color = vbRed
    .LanguageID = msoLanguageIDEnglishUS
    End With
    
    Case Else 'do nothing
    End Select
    
    Next L
    I always expect the student to do their homework and find all the errrors I leeve in.

    Please take the time to read the Forum FAQ

  11. #11
    VBAX Regular
    Joined
    Dec 2015
    Posts
    69
    Location
    Thanks for providing more professional code.

    how can i select only space between 2 red characters or between 2 characters that have msoLanguageIDEnglishUS ?

  12. #12
    Moderator VBAX Wizard SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    6,979
    Location
    Move the Select Case to a Function, but rewrite the Case's like

    Private Function CharType(Letter As String) As String
       Select Case AscW(Letter) 
        Case  < 48 'do nothing
        Case < 58 '0-9
            CharType = "English
      Case is = (Number for Space)
    CharType = "Space"
    '
    '
    '
    End Select
    End Function
    Then your loop
    For L = 1 To .Characters.Count 
    If CharType(.Characters(L)) = "English" Then
            With .Characters(L) 
                .Font.Color = vbRed 
                .LanguageID = msoLanguageIDEnglishUS 
            End With 
    
    ElseIf CharType(.Characters(L)) = "Space" Then
    If CharType(.Characters(L - 1)) = "English" And CharType(.Characters(L + 1)) = "English" Then
    'Do Space Stuff on Character L
    End If
    End If
    Next L
    I always expect the student to do their homework and find all the errrors I leeve in.

    Please take the time to read the Forum FAQ

  13. #13
    VBAX Regular
    Joined
    Dec 2015
    Posts
    69
    Location
    Thanks SamT for your reply; Kindly note that i'm not a developer like you (an Expert) and my information is very limited on that matters so can you plz help me how to do your 2 suggestions:

    Move the Select Case to a Function, but rewrite the Case's like
    Then your loop



  14. #14
    VBAX Regular
    Joined
    Dec 2015
    Posts
    69
    Location
    i used the below suggested code but space is not changed yes:

    Sub Baset_PowerPoint_Language()


    Dim sld As Slide
    Dim shp As Shape
    Dim L As Long

    For Each sld In ActivePresentation.Slides
    For Each shp In sld.Shapes


    If shp.HasTextFrame Then
    shp.TextFrame.TextRange.Font.Name = "Arial"
    shp.TextFrame.TextRange.Font.NameComplexScript = "Arial"
    shp.TextFrame.TextRange.ParagraphFormat.TextDirection = ppDirectionRightToLeft
    shp.TextFrame.TextRange.RtlRun
    End If
    Next shp
    sld.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Font.Name = "Arial"
    sld.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Font.NameComplexSc ript = "Arial"
    sld.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.ParagraphFormat.Te xtDirection = ppDirectionRightToLeft
    sld.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.RtlRun
    Next sld




    For Each sld In ActivePresentation.Slides
    For Each shp In sld.Shapes
    If shp.HasTextFrame Then
    If shp.TextFrame.HasText Then
    With shp.TextFrame.TextRange
    For L = 1 To .Characters.Count
    If CharType(.Characters(L)) = "English" Then
    With .Characters(L)
    .Font.Color = vbRed
    .LanguageID = msoLanguageIDEnglishUS
    End With

    ElseIf CharType(.Characters(L)) = "Space" Then
    If CharType(.Characters(L - 1)) = "English" And CharType(.Characters(L + 1)) = "English" Then
    'Do Space Stuff on Character L
    With .Characters(L)
    .Font.Color = vbRed
    .LanguageID = msoLanguageIDEnglishUS
    End With
    End If
    End If
    Next L
    End With
    End If
    End If
    Next shp
    Next sld










    End Sub




    Private Function CharType(Letter As String) As String
    Select Case AscW(Letter)
    Case Is < 48 'do nothing
    Case Is < 58 '0-9
    CharType = "English"
    Case Is = 32
    CharType = "Space"
    Case Is < 65 'do nothing
    Case Is < 91 '0-9
    CharType = "English"
    Case Is < 97 'do nothing
    Case Is < 123 '0-9
    CharType = "English"
    Case Is = 174
    CharType = "English"
    Case Is = 8482
    CharType = "English"
    End Select
    End Function

  15. #15
    Moderator VBAX Wizard SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    6,979
    Location
    but space is not changed
    How do you know? You can't "see" a space character, so it has no color.

    The code looks good. I rewrote the Sub Baset for speed. I hope I put all the lines in the right loops.


    I added some code lines to place a double underline on all Spaces worked on. See the Comments to see how to remove them after testing. Run this sub and look for double Underlines where Spaces are.
    Sub Baset_PowerPoint_Language()
    
    Dim sld As Slide
    Dim shp As Shape
    Dim L As Long
    
    For Each sld In ActivePresentation.Slides
      For Each shp In sld.Shapes
      
        If shp.HasTextFrame Then
          'Using "Wtih" is faster
          With shp.TextFrame.TextRange
            .Font.Name = "Arial"
            .Font.NameComplexScript = "Arial"
            .ParagraphFormat.TextDirection = ppDirectionRightToLeft
            .RtlRun
              
            For L = 1 To .Characters.Count
              If CharType(.Characters(L)) = "English" Then
                With .Characters(L)
                  .Font.Color = vbRed
                  .LanguageID = msoLanguageIDEnglishUS
                End With
              
              ElseIf CharType(.Characters(L)) = "Space" Then
                If CharType(.Characters(L - 1)) = "English" And CharType(.Characters(L + 1)) = "English" Then
                  'Do Space Stuff on Character L
                  With .Characters(L)
    
                    'X Line: Remove all X lines after testing
                    .Font.Underline = -4119 'X line:  = Double under line
                    'X line: Uncomment next line to remove underlines
                    '.Font.Underline = -4142 'X line: = no underline
    
                    .Font.Color = vbRed
                    .LanguageID = msoLanguageIDEnglishUS
                  End With
                End If
              End If
            Next L
         
          End With
        End If
      Next shp
      
      With sld.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange
        .Font.Name = "Arial"
        .Font.NameComplexSc ript = "Arial"
        .ParagraphFormat.Te xtDirection = ppDirectionRightToLeft
        .RtlRun
      End With
    Next sld
    
    End Sub
    Private Function CharType(Letter As String) As String
      Select Case AscW(Letter)
      Case Is < 48 'do nothing
      Case Is < 58 '0-9
        CharType = "English"
      Case Is = 32
        CharType = "Space"
      Case Is < 65 'do nothing
      Case Is < 91 '0-9
        CharType = "English"
      Case Is < 97 'do nothing
      Case Is < 123 '0-9
        CharType = "English"
      Case Is = 174
        CharType = "English"
      Case Is = 8482
        CharType = "English"
      End Select
    End Function
    I always expect the student to do their homework and find all the errrors I leeve in.

    Please take the time to read the Forum FAQ

  16. #16
    VBAX Regular
    Joined
    Dec 2015
    Posts
    69
    Location
    Dear SamT

    You are the master; Thanks for re-writing the code in better way; kindly note that i tested it and i'm going crazy as the spaces still not changed/affected although the code seems perfect:

    04-Dec-15 2-46-39 PM.jpg

  17. #17
    VBAX Regular
    Joined
    Dec 2015
    Posts
    69
    Location
    I changed some code on the Function and the below code is worked well:

    Sub Baset_PowerPoint_Language()

    Dim sld As Slide
    Dim shp As Shape
    Dim L As Long

    For Each sld In ActivePresentation.Slides
    For Each shp In sld.Shapes

    If shp.HasTextFrame Then

    With shp.TextFrame.TextRange
    .Font.Name = "Arial"
    .Font.NameComplexScript = "Arial"
    .ParagraphFormat.TextDirection = ppDirectionRightToLeft
    .RtlRun

    For L = 1 To .Characters.Count
    If CharType(.Characters(L)) = "English" Then
    With .Characters(L)
    .Font.Color = vbRed
    .LanguageID = msoLanguageIDEnglishUS
    End With

    ElseIf CharType(.Characters(L)) = "Space" Then
    If CharType(.Characters(L - 1)) = "English" And CharType(.Characters(L + 1)) = "English" Then
    With .Characters(L)
    '.Font.Underline = -4119
    .LanguageID = msoLanguageIDEnglishUS
    End With
    End If
    End If
    Next L

    End With
    End If
    Next shp

    With sld.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange
    .Font.Name = "Arial"
    .Font.NameComplexScript = "Arial"
    .ParagraphFormat.TextDirection = ppDirectionRightToLeft
    .RtlRun
    End With
    Next sld

    End Sub




    Private Function CharType(Letter As String) As String
    Select Case AscW(Letter)

    Case Is = 32
    CharType = "Space"

    Case 48 To 57 '0-9
    CharType = "English"

    Case 65 To 90 'A-Z
    CharType = "English"

    Case 97 To 122 'a-z
    CharType = "English"

    Case Is = 174 '
    CharType = "English"

    Case Is = 8482 '™
    CharType = "English"

    End Select
    End Function

  18. #18
    VBAX Regular
    Joined
    Dec 2015
    Posts
    69
    Location
    Now the last request here:

    How can i made the same "English" "Space" changes applied also for the Notes text ???

  19. #19
    VBAX Regular
    Joined
    Dec 2015
    Posts
    69
    Location
    I manged the Notes issue.

    THANKS ALL HELPING ME TO DO THAT HARD REQUEST.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •