Translate text on image using Excel with ChatGPT

You probably already know, OpenAI ChatGPT can do a lot of wonders, I will not spend much time describe how great it is, let’s make it to do some serious work for us? I have a friend who recently came to me with 2 problems:

1. He need to manually type the text on images, on Words or something
2. He need to translate the text

So, it get me thinking, we can solve this by using 1 method, to 2 problems above. Ok, this method is the combination of Excel with OpenAI ChatGPT.

1. First of all, you will got to create an Excel file, and save it as .xlsm file, which is Macro enabled.

2. Under the menu bar, look for “Developer”, and then click on “Visual Basic”. If you can’t see the Developer tab, click here.

3. Next, under the Visual Basic, navigate to the menu “Tools”, and “References”, add the library called “Microsoft XML, v6.0”

4. Navigate to the menu “Insert”, and select “Module”

5. You shall see Project dialogue appear with “Module 1”, click on it, and paste the below code. Please paste your own OpenAPI Key at the code below. Don’t worry, you don’t need to understand it. This is LowCode 101, even there is a code needed, I will prepare it for you.

Option Explicit
Private p&, token, dic


Function TranslateCell(cellContent As Range, targetLanguage As String) As String
Dim httpRequest As Object
Dim apiKey As String
Dim apiUrl As String
Dim postData As String
Dim response As String
Dim jsonResponse As Object
Dim translatedText As String

' Replace with your OpenAI API key
apiKey = "YOUR-OPEN-API-KEY"

' Set the API URL for ChatGPT 3.5
apiUrl = "https://api.openai.com/v1/chat/completions"

' Prepare the POST data
postData = "{""model"": ""gpt-3.5-turbo"", ""messages"": [{""role"": ""system"", ""content"": ""You are an expert translator""}, {""role"": ""user"", ""content"": ""Translate this word into " & targetLanguage & ", answer only: " & cellContent.Text & """}], ""temperature"":0.7, ""max_tokens"":1000, ""top_p"":1, ""frequency_penalty"":0, ""presence_penalty"":0}"

' Clean up escape caharacters
postData = Replace(postData, "'", "")

' Create an HTTP request object
Set httpRequest = CreateObject("MSXML2.ServerXMLHTTP.6.0")

' Configure the HTTP request
With httpRequest
.Open "POST", apiUrl, False
.SetRequestHeader "Content-Type", "application/json"
.SetRequestHeader "Authorization", "Bearer " & apiKey
.Send postData
End With

' Get the HTTP response
response = httpRequest.ResponseText

' Parse the JSON response
Set jsonResponse = ParseJSON(response)

' Get the translated text
translatedText = jsonResponse("obj.choices(0).message.content")

' Return the translated text
TranslateCell = translatedText
End Function


Function ParseJSON(json$, Optional key$ = "obj") As Object
p = 1
token = Tokenize(json)
Set dic = CreateObject("Scripting.Dictionary")
If token(p) = "{" Then ParseObj key Else ParseArr key
Set ParseJSON = dic
End Function
Function ParseObj(key$)
Do: p = p + 1
Select Case token(p)
Case "]"
Case "[": ParseArr key
Case "{"
If token(p + 1) = "}" Then
p = p + 1
dic.Add key, "null"
Else
ParseObj key
End If

Case "}": key = ReducePath(key): Exit Do
Case ":": key = key & "." & token(p - 1)
Case ",": key = ReducePath(key)
Case Else: If token(p + 1) <> ":" Then dic.Add key, token(p)
End Select
Loop
End Function
Function ParseArr(key$)
Dim e&
Do: p = p + 1
Select Case token(p)
Case "}"
Case "{": ParseObj key & ArrayID(e)
Case "[": ParseArr key
Case "]": Exit Do
Case ":": key = key & ArrayID(e)
Case ",": e = e + 1
Case Else: dic.Add key & ArrayID(e), token(p)
End Select
Loop
End Function
'-------------------------------------------------------------------
' Support Functions
'-------------------------------------------------------------------
Function Tokenize(s$)
Const Pattern = """(([^""\\]|\\.)*)""|[+\-]?(?:0|[1-9]\d*)(?:\.\d*)?(?:[eE][+\-]?\d+)?|\w+|[^\s""']+?"
Tokenize = RExtract(s, Pattern, True)
End Function
Function RExtract(s$, Pattern, Optional bGroup1Bias As Boolean, Optional bGlobal As Boolean = True)
Dim c&, m, n, v
With CreateObject("vbscript.regexp")
.Global = bGlobal
.MultiLine = False
.IgnoreCase = True
.Pattern = Pattern
If .TEST(s) Then
Set m = .Execute(s)
ReDim v(1 To m.Count)
For Each n In m
c = c + 1
v(c) = n.Value
If bGroup1Bias Then If Len(n.submatches(0)) Or n.Value = """""" Then v(c) = n.submatches(0)
Next
End If
End With
RExtract = v
End Function
Function ArrayID$(e)
ArrayID = "(" & e & ")"
End Function
Function ReducePath$(key$)
If InStr(key, ".") Then ReducePath = Left(key, InStrRev(key, ".") - 1) Else ReducePath = key
End Function
Function ListPaths(dic)
Dim s$, v
For Each v In dic
s = s & v & " --> " & dic(v) & vbLf
Next
Debug.Print s
End Function
Function GetFilteredValues(dic, match)
Dim c&, i&, v, w
v = dic.keys
ReDim w(1 To dic.Count)
For i = 0 To UBound(v)
If v(i) Like match Then
c = c + 1
w(c) = dic(v(i))
End If
Next
ReDim Preserve w(1 To c)
GetFilteredValues = w
End Function
Function GetFilteredTable(dic, cols)
Dim c&, i&, j&, v, w, z
v = dic.keys
z = GetFilteredValues(dic, cols(0))
ReDim w(1 To UBound(z), 1 To UBound(cols) + 1)
For j = 1 To UBound(cols) + 1
z = GetFilteredValues(dic, cols(j - 1))
For i = 1 To UBound(z)
w(i, j) = z(i)
Next
Next
GetFilteredTable = w
End Function
Function OpenTextFile$(f)
With CreateObject("ADODB.Stream")
.Charset = "utf-8"
.Open
.LoadFromFile f
OpenTextFile = .ReadText
End With
End Function

6. You basically done. Now copy the image that contain text you want to translate.

7. Navigate in your Excel file, to “Data” menu, select “From Picture”, and select either from File or Clipboard. Sometime you may encounter server busy error, just try again in a while.

8. You shall see the text being populated into the cell. Pick those text that you want to translate, and write the below formula at targetted cell’s formula

=TranslateCell ([CELL-YOU-WANT-TO-TRANSLATE], "[LANGUAGE-YOU-WANT]")

9. You can change to the language you want to translate to, with the same formula.