Link to home
Start Free TrialLog in
Avatar of jocker panda
jocker panda

asked on

How to maintain indentation in powerpoint using VBA REGEX is working?

I'm using below code to translate power point text using VBA but im not able to maintain indentation when translated text is copied to the slide
please help . below code uses google translator UTF-8 format as translator.
i'm a newbie pls help
pls explain how regex is working here
thanks in advance



Sub TranslateKorToEng()
 
Dim selectedShape As Shape
Dim translateFrom As String, translateTo As String
Dim getParam As String, trans As String
Dim r As Integer, c As Integer, x As Long, y As Long
Dim groupCount As Integer, gg As Integer
 
translateFrom = "Kr" 'source language indication
translateTo = "en"  'result language indication
 
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")  ' create object(shape,textframe,table) using HTTP format
 
If ActiveWindow.Selection.Type = ppSelectionText Then ' if only text is selected
    getParam = ConvertToGet(ActiveWindow.Selection.TextRange.Text)  ' replaces special symbols and applies text to convert to get function
    URL = "https://translate.google.pl/m?hl=" & translateFrom & "&sl=" & translateFrom & "&tl=" & translateTo & "&ie=UTF-8&prev=_m&q=" & getParam ' Creats and modifies the URL of UTF-8 translator with getparam
    objHTTP.Open "GET", URL, False 'open the http object
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)" 'send command to browser
    objHTTP.send ("") ' send command
           
    If InStr(objHTTP.responseText, "div dir=""ltr""") > 0 Then
        trans = RegexExecute(objHTTP.responseText, "div[^""]*?""ltr"".*?>(.+?)</div>") 'actual translator working function
        ActiveWindow.Selection.TextRange.Text = ReplaceEnter(Clean(trans)) 'input result data into selection frame or shape after modifying with clean function
    End If
Else
 
 
For Each selectedShape In ActiveWindow.Selection.ShapeRange ' checks multiple shapes
 
   
    If selectedShape.Type = msoGroup Then 'Check Whether selected Shape is Group or not
        groupCount = selectedShape.GroupItems.Count 'no. of groups (groups inside group)
       
        For gg = 1 To groupCount 'using for group through each text box in a group
            If selectedShape.GroupItems(gg).HasTextFrame Then 'check for textframe
                If selectedShape.GroupItems(gg).TextFrame.HasText Then ' check for textframe. text
               
                    selectedShape.GroupItems(gg).TextFrame.WordWrap = msoCTrue ' wordwraps the textbox
                    selectedShape.GroupItems(gg).TextFrame2.AutoSize = msoAutoSizeTextToFitShape   'this 2 line for text fit to TextBox(Font size is changed)
                   
                    getParam = ConvertToGet(selectedShape.GroupItems(gg).TextFrame.TextRange.Text) 'brackets should always have text (input to translator)
                    URL = "https://translate.google.pl/m?hl=" & translateFrom & "&sl=" & translateFrom & "&tl=" & translateTo & "&ie=UTF-8&prev=_m&q=" & getParam
                    objHTTP.Open "GET", URL, False
                    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
                    objHTTP.send ("")
           
                    If InStr(objHTTP.responseText, "div dir=""ltr""") > 0 Then
                        trans = RegexExecute(objHTTP.responseText, "div[^""]*?""ltr"".*?>(.+?)</div>")
                        selectedShape.GroupItems(gg).TextFrame.TextRange.Text = ReplaceEnter(Clean(trans))
                    End If
                End If
            End If
        Next
     
    '¿©±ä µµÇü, ÅؽºÆ® "óÀÚ Ã¼Å·
    ElseIf selectedShape.HasTextFrame Then 'for only shape
        If selectedShape.TextFrame.HasText Then 'and it has text
       
            selectedShape.TextFrame.WordWrap = msoCTrue 'Set WordWrap
            selectedShape.TextFrame2.AutoSize = msoAutoSizeTextToFitShape
           
           
            getParam = ConvertToGet(selectedShape.TextFrame.TextRange.Text)
            URL = "https://translate.google.pl/m?hl=" & translateFrom & "&sl=" & translateFrom & "&tl=" & translateTo & "&ie=UTF-8&prev=_m&q=" & getParam
            objHTTP.Open "GET", URL, False
            objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
            objHTTP.send ("")
           
            If InStr(objHTTP.responseText, "div dir=""ltr""") > 0 Then
              trans = RegexExecute(objHTTP.responseText, "div[^""]*?""ltr"".*?>(.+?)</div>")
             selectedShape.TextFrame.TextRange.Text = ReplaceEnter(Clean(trans))
            End If
        End If
       
    '¿©±ä Å×À̺í checking
    ElseIf selectedShape.HasTable Then
    With selectedShape
row:
      If .Type = 19 Then ' type 19 is table mso object
        r = 0
        For y = 1 To .Table.Columns.Count
            If r = 0 Then
                For x = 1 To .Table.Rows.Count
                    If .Table.Cell(x, y).Selected Then 'check if the column.row is selected or not
                       
                        If .Table.Cell(x, y).Shape.HasTextFrame Then 'checks for text frame
                           
                            getParam = ConvertToGet(.Table.Cell(x, y).Shape.TextFrame.TextRange.Text)
                            URL = "https://translate.google.pl/m?hl=" & translateFrom & "&sl=" & translateFrom & "&tl=" & translateTo & "&ie=UTF-8&prev=_m&q=" & getParam
                            objHTTP.Open "GET", URL, False
                            objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
                            objHTTP.send ("")
           
                            If InStr(objHTTP.responseText, "div dir=""ltr""") > 0 Then
                                trans = RegexExecute(objHTTP.responseText, "div[^""]*?""ltr"".*?>(.+?)</div>")
                                .Table.Cell(x, y).Shape.TextFrame.TextRange.Text = ReplaceEnter(Clean(trans))
                            End If
                        End If
                    End If
                Next
            Else
                GoTo Column
            End If
        Next
    Else
        MsgBox "Ç¥ ¼±ÅÃ"
    End If
Column:
    If .Type = 19 Then ' type 19 is table
        c = 0
        For x = 1 To .Table.Rows.Count
            If c = 0 Then
                For y = 1 To .Table.Columns.Count
                    If .Table.Cell(x, y).Selected Then 'Àüü Å×À̺íÀ" ÇÑ ¼¿¾¿ °ËÅäÇÏ¸é ¼±ÅõȰ͸¸ ó¸®ÇÑ´Ù
                       
                        If .Table.Cell(x, y).Shape.HasTextFrame Then
                           
                            getParam = ConvertToGet(.Table.Cell(x, y).Shape.TextFrame.TextRange.Text)
                            URL = "https://translate.google.pl/m?hl=" & translateFrom & "&sl=" & translateFrom & "&tl=" & translateTo & "&ie=UTF-8&prev=_m&q=" & getParam
                            objHTTP.Open "GET", URL, False
                            objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
                            objHTTP.send ("")
           
                            If InStr(objHTTP.responseText, "div dir=""ltr""") > 0 Then
                                trans = RegexExecute(objHTTP.responseText, "div[^""]*?""ltr"".*?>(.+?)</div>")
                                .Table.Cell(x, y).Shape.TextFrame.TextRange.Text = ReplaceEnter(Clean(trans))
                            End If
                        End If
                    End If
                Next
            Else
            End If
        Next
    Else
        MsgBox "need to select table"
    End If
End With
    End If
Next selectedShape
End If
 
End Sub
'---SB Functions for ++ sign to Enter ----'new line symbol while entering data from ppt
Function ReplaceEnter(val As String)
    val = Replace(val, "++", vbCrLf) 'new line
    ReplaceEnter = val
End Function
'----Used functions----' new line to symbol and other symbol changes while taking data from ppt
Function ConvertToGet(val As String) 'replace symbols for selected text, object ,url format
    val = Replace(val, "&", "and")
    val = Replace(val, "<", "[")
    val = Replace(val, ">", "]")
    val = Replace(val, " ", "+")
    val = Replace(val, Chr$(11), "+%2B%2B")  'LineFeed vbLf Chr$(11) two kinds of new line in ppt shift entr and entr
    val = Replace(val, Chr$(13), "+%2B%2B")  'LineFeed vbLf Chr$(11)
    val = Replace(val, "(", "%28")
    val = Replace(val, ")", "%29")
    'val = Replace(val, vbNewLine, "+")
    ConvertToGet = val
End Function
Function Clean(val As String) 'to clean symbol code to symbol
    val = Replace(val, """, """")
    val = Replace(val, "%2C", ",")
    val = Replace(val, "'", "'")
    Clean = val
End Function
Public Function RegexExecute(str As String, reg As String, _
                             Optional matchIndex As Long, _
                             Optional subMatchIndex As Long) As String
    On Error GoTo ErrHandl
    Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = reg
    regex.Global = Not (matchIndex = 0 And subMatchIndex = 0) 'For efficiency
    If regex.Test(str) Then
        Set matches = regex.Execute(str)
        RegexExecute = matches(matchIndex).SubMatches(subMatchIndex)
        Exit Function
    End If
ErrHandl:
    RegexExecute = CVErr(xlErrValue)
End Function
Avatar of Jamie Garroch (MVP)
Jamie Garroch (MVP)
Flag of United Kingdom of Great Britain and Northern Ireland image

Your question is "how is REGEX working?" You can find information of regular expressions at this website:

https://www.regular-expressions.info/

Basically, regular expressions are being used to locate the translated plain text within Google's returned HTML code that is created by your translation query.

So applying this to your code, here are some comments for the RegexExecute procedure:

' str = html content from the page returned by the Google translate query
' reg = regular expression search pattern string e.g. div[^"]*?"ltr".*?>(.+?)</div>
' e.g. looking for this HTML part : <div dir="ltr" class="t0">Hello World</div>
Public Function RegexExecute(str As String, reg As String, _
                             Optional matchIndex As Long, _
                             Optional subMatchIndex As Long) As String
    On Error GoTo ErrHandl
    Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = reg
    regex.Global = Not (matchIndex = 0 And subMatchIndex = 0) 'For efficiency
    If regex.Test(str) Then
        ' Return a collection of string matches from the source HTML based on the pattern
        ' e.g. matches(0) = div><br><div dir="ltr" class="t0">Hello World</div>
        Set matches = regex.Execute(str)
        ' Return the translated plain text from the match via the (.+?) part of the expression pattern
        ' e.g. matches(0).SubMatches(0) = Hello World
        RegexExecute = matches(matchIndex).SubMatches(subMatchIndex)
        Exit Function
    End If
ErrHandl:
    RegexExecute = CVErr(xlErrValue)
End Function

Open in new window


By the way, I could't get your code to compile due to an error on the second line of the Clean function so I modified it by adding an additional quote mark in the second argument as follows:

Function Clean(val As String) 'to clean symbol code to symbol
    val = Replace(val, """", """")
    val = Replace(val, "%2C", ",")
    val = Replace(val, "'", "'")
    Clean = val
End Function

Open in new window

Avatar of jocker panda
jocker panda

ASKER

Dear Jamie,

Thanks for your detailed explanation about regex.

Today i'm facing a problem with this code as its returns html values to symbols like <,> etc, which are shown as &lt; & gt; etc.,
After googling, i came to know that its a html to text encoding problem
can you help me what function and where to implement that code in my above code.

Thanks a lot in advance.
ASKER CERTIFIED SOLUTION
Avatar of Jamie Garroch (MVP)
Jamie Garroch (MVP)
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Do you have a URL for the new question regarding &lt; and &gt; html codes?