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.Serve rXMLHTTP") ' create object(shape,textframe,tab le) using HTTP format
If ActiveWindow.Selection.Typ e = 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.respo nseText, "div[^""]*?""ltr"".*?>(.+? )</div>") 'actual translator working function
ActiveWindow.Selection.Tex tRange.Tex t = 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.Sha peRange ' checks multiple shapes
If selectedShape.Type = msoGroup Then 'Check Whether selected Shape is Group or not
groupCount = selectedShape.GroupItems.C ount 'no. of groups (groups inside group)
For gg = 1 To groupCount 'using for group through each text box in a group
If selectedShape.GroupItems(g g).HasText Frame Then 'check for textframe
If selectedShape.GroupItems(g g).TextFra me.HasText Then ' check for textframe. text
selectedShape.GroupItems(g g).TextFra me.WordWra p = msoCTrue ' wordwraps the textbox
selectedShape.GroupItems(g g).TextFra me2.AutoSi ze = msoAutoSizeTextToFitShape 'this 2 line for text fit to TextBox(Font size is changed)
getParam = ConvertToGet(selectedShape .GroupItem s(gg).Text Frame.Text Range.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.respo nseText, "div[^""]*?""ltr"".*?>(.+? )</div>")
selectedShape.GroupItems(g g).TextFra me.TextRan ge.Text = ReplaceEnter(Clean(trans))
End If
End If
End If
Next
'¿©±ä µµÇü, ÅؽºÆ® "óÀÚ Ã¼Å·
ElseIf selectedShape.HasTextFrame Then 'for only shape
If selectedShape.TextFrame.Ha sText Then 'and it has text
selectedShape.TextFrame.Wo rdWrap = msoCTrue 'Set WordWrap
selectedShape.TextFrame2.A utoSize = 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.respo nseText, "div[^""]*?""ltr"".*?>(.+? )</div>")
selectedShape.TextFrame.Te xtRange.Te xt = 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.TextRan ge.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.respo nseText, "div[^""]*?""ltr"".*?>(.+? )</div>")
.Table.Cell(x, y).Shape.TextFrame.TextRan ge.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.TextRan ge.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.respo nseText, "div[^""]*?""ltr"".*?>(.+? )</div>")
.Table.Cell(x, y).Shape.TextFrame.TextRan ge.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.Reg Exp"): 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).SubMat ches(subMa tchIndex)
Exit Function
End If
ErrHandl:
RegexExecute = CVErr(xlErrValue)
End Function
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.Serve
If ActiveWindow.Selection.Typ
getParam = ConvertToGet(ActiveWindow.
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
trans = RegexExecute(objHTTP.respo
ActiveWindow.Selection.Tex
End If
Else
For Each selectedShape In ActiveWindow.Selection.Sha
If selectedShape.Type = msoGroup Then 'Check Whether selected Shape is Group or not
groupCount = selectedShape.GroupItems.C
For gg = 1 To groupCount 'using for group through each text box in a group
If selectedShape.GroupItems(g
If selectedShape.GroupItems(g
selectedShape.GroupItems(g
selectedShape.GroupItems(g
getParam = ConvertToGet(selectedShape
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
trans = RegexExecute(objHTTP.respo
selectedShape.GroupItems(g
End If
End If
End If
Next
'¿©±ä µµÇü, ÅؽºÆ® "óÀÚ Ã¼Å·
ElseIf selectedShape.HasTextFrame
If selectedShape.TextFrame.Ha
selectedShape.TextFrame.Wo
selectedShape.TextFrame2.A
getParam = ConvertToGet(selectedShape
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
trans = RegexExecute(objHTTP.respo
selectedShape.TextFrame.Te
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
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
trans = RegexExecute(objHTTP.respo
.Table.Cell(x, y).Shape.TextFrame.TextRan
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
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
trans = RegexExecute(objHTTP.respo
.Table.Cell(x, y).Shape.TextFrame.TextRan
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.Reg
regex.Global = Not (matchIndex = 0 And subMatchIndex = 0) 'For efficiency
If regex.Test(str) Then
Set matches = regex.Execute(str)
RegexExecute = matches(matchIndex).SubMat
Exit Function
End If
ErrHandl:
RegexExecute = CVErr(xlErrValue)
End Function
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 < & 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.
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 < & 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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Do you have a URL for the new question regarding < and > html codes?
https://www.regular-expres
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:
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:
Open in new window