Excel财务报表翻译

Function QH_有道翻译_函数(qh_CanShu0) '作者：阙辉   20210518
Dim strText As String
Dim strCookie As String
Dim xmlobject, xmlobject1 As Object
Dim qh_CanShu

qh_CanShu = qh_CanShu0
'拼接post传递参数
qh_CanShu = "&q=" & qh_CanShu & "&from=Auto&to=Auto"
'MsgBox qh_CanShu
Set xmlobject = CreateObject("WinHttp.WinHttpRequest.5.1")
With xmlobject
    .Open "post", "https://aidemo.youdao.com/trans", False
    '请求头信息
    .setRequestHeader "Accept", "application/json,text/javascript,*/*;q=0.01"
'    .setRequestHeader "Accept-Encoding", "gzip,deflate,br"
    .setRequestHeader "Accept-Language", "zh-CN,zh;q=0.9"
    .setRequestHeader "Connection", "keep-alive"
    .setRequestHeader "Content-Length", "100000"
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded;charset=UTF-8"
    .setRequestHeader "Host", "aidemo.youdao.com"
    .setRequestHeader "Origin", "https//ai.youdao.com"
    .setRequestHeader "Referer", "https//ai.youdao.com/product-fanyi-text.s"
    .setRequestHeader "Sec-Fetch-Dest", "empty"
    .setRequestHeader "Sec-Fetch-Mode", "cors"
    .setRequestHeader "Sec-Fetch-Site", "same-site"
    .setRequestHeader "User-Agent", "Mozilla/5.0(WindowsNT10.0;WOW64)AppleWebKit/537.36(KHTML,likeGecko)Chrome/86.0.4240.198Safari/537.36"
    '传递参数
    .Send qh_CanShu
    '输出结果
    strText = .responsetext
'    MsgBox strText
End With

QH_有道翻译_函数 = strText

End Function

Function QH_有道翻译_解析(qh_Reques0) '作者：阙辉   20210518

Dim qh_Reques

qh_Reques = qh_Reques0

'解析返回状态  0表示成功
qh_errorCode = Split(qh_Reques, "errorCode" & """:""")(1)
qh_errorCode = Split(qh_errorCode, """,""")(0)

'返回翻译的结果
qh_translation = Split(qh_Reques, "translation" & """:[""")(1)
qh_translation = Split(qh_translation, """],""")(0)

'0是状态  1是结果
QH_有道翻译_解析 = Array(qh_errorCode, qh_translation)

End Function

Function QH_有道翻译_Main(qh_ShuJu0)

qh_ShuJu = qh_ShuJu0

'qh_CanShu = "世界你好"

qh_Reques = QH_有道翻译_函数(qh_ShuJu)

qh_JieGuo = QH_有道翻译_解析(qh_Reques)

QH_有道翻译_Main = qh_JieGuo

End Function

Function QH_有道翻译_Main_sheet(qh_ShuJu0)
qh_ShuJu = qh_ShuJu0

If qh_ShuJu <> "" Then
    qh_JieGuo = QH_有道翻译_Main(qh_ShuJu)
    qh_star = qh_JieGuo(0)
    qh_jieguo_oo = qh_JieGuo(1)
    If qh_star = 0 Then
        qh_FanYi_JieGuo = qh_jieguo_oo
    Else
        qh_FanYi_JieGuo = "翻译失败，QH!"
    End If
Else
    qh_FanYi_JieGuo = ""
End If

QH_有道翻译_Main_sheet = qh_FanYi_JieGuo
End Function


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'MsgBox Target.Row
'MsgBox Target.Column
'MsgBox Target.Address
On Error Resume Next

If Target.Column = 2 Then
'    qh_row_01 = 0
'    qh_column_01 = 0
'
'    If qh_row_01 <> 0 And qh_column_01 <> 0 Then
'        Cells(qh_row_01, qh_column_01).ClearComments
'    End If

    Range("B1:B1000").ClearComments
    
    qh_row_00 = Target.Row
    qh_column_00 = Target.Column

'    qh_row_01 = qh_row_00
'    qh_column_01 = qh_column_00


    With Cells(qh_row_00, qh_column_00)
        qh_shuju00 = .Value
        '如果数据为空则不翻译
        If qh_shuju00 <> "" Then
            qh_JieGuo = QH_有道翻译_Main(qh_shuju00)
            qh_star = qh_JieGuo(0)
            qh_jieguo_oo = qh_JieGuo(1)
            If qh_star = 0 Then
                qh_FanYi_JieGuo = qh_jieguo_oo
            Else
                qh_FanYi_JieGuo = "翻译失败，QH!"
            End If
            '先删除原有批注
            .ClearComments
            '新增批注
            .AddComment
            
            .Comment.Text Text:=qh_FanYi_JieGuo
            .Comment.Visible = True
            
            With .Comment.Shape
                .TextFrame.AutoSize = True  '自动适应内容大小
'                .Width = 168  '修改批注的长度
'                .Height = 15  '修改批注的宽度
                .Fill.Visible = msoFalse   '将批注设置为透明
                .Line.ForeColor.SchemeColor = 53
'                .AutoShapeType = msoShapeRoundedRectangle       '圆角边框
                .Line.Weight = 0.1                                                       '边框粗细
                With .TextFrame.Characters.Font
                '设置字体
                    .Name = "华文楷体"
                    .FontStyle = "加粗"
                    .Size = 16
'                    .ColorIndex = 5
                    .Color = -16776961
    '                .Strikethrough = False
    '                .Superscript = False
    '                .Subscript = False
    '                .OutlineFont = False
    '                .Shadow = False
    '                .Underline = xlUnderlineStyleNone
    '                .ColorIndex = xlAutomatic
    '                .TintAndShade = 0
    '                .ThemeFont = xlThemeFontNone
    

                End With
                With .TextFrame.Characters.Font
                    .ThemeColor = xlThemeColorDark1
                End With
            End With
        End If
    End With

End If


End Sub