{"id":1706,"date":"2012-05-20T15:41:20","date_gmt":"2012-05-20T06:41:20","guid":{"rendered":"http:\/\/www.ka-net.org\/blog\/?p=1706"},"modified":"2014-03-13T15:58:49","modified_gmt":"2014-03-13T06:58:49","slug":"google%e3%81%a8yahoo%e3%81%a7%e5%90%8c%e6%99%82%e3%81%ab%e7%bf%bb%e8%a8%b3%e3%81%99%e3%82%8bword%e3%83%9e%e3%82%af%e3%83%ad","status":"publish","type":"post","link":"https:\/\/www.ka-net.org\/blog\/?p=1706","title":{"rendered":"Google\u3068Yahoo!\u3067\u540c\u6642\u306b\u7ffb\u8a33\u3059\u308bWord\u30de\u30af\u30ed"},"content":{"rendered":"

\u300cGoogle\u7ffb\u8a33\u3067\u6587\u5b57\u5217\u3092\u7ffb\u8a33\u3059\u308b\u30de\u30af\u30ed<\/a>\u300d\u3068\u300cYahoo!\u7ffb\u8a33\u3067\u6587\u5b57\u5217\u3092\u7ffb\u8a33\u3059\u308b\u30de\u30af\u30ed<\/a>\u300d\u306e2\u3064\u3092\u5229\u7528\u3057\u3066\u3001Google\u7ffb\u8a33\u3068Yahoo!\u7ffb\u8a33\u3067\u540c\u6642\u306b\u7ffb\u8a33\u3092\u884c\u3046Word\u30de\u30af\u30ed\u3092\u4f5c\u6210\u3057\u3066\u307f\u307e\u3057\u305f\u3002
\n\u7d50\u679c\u306f\u65b0\u3057\u3044\u6587\u66f8\u306b\u8868\u793a\u3055\u308c\u307e\u3059\u3002<\/p>\n

\"\"<\/a><\/p>\n

\u203b \u4e0b\u8a18\u30de\u30af\u30ed\u306fGoogle\u7ffb\u8a33\u3068Yahoo!\u7ffb\u8a33\u306e\u4ed5\u69d8\u306b\u4f9d\u5b58\u3057\u307e\u3059\u3002\u6025\u306a\u4ed5\u69d8\u5909\u66f4\u306b\u3088\u3063\u3066\u4e0b\u8a18\u30de\u30af\u30ed\u304c\u52d5\u4f5c\u3057\u306a\u304f\u306a\u308b\u53ef\u80fd\u6027\u304c\u3042\u308a\u307e\u3059\u306e\u3067\u3001\u305d\u306e\u70b9\u306f\u3054\u6ce8\u610f\u304f\u3060\u3055\u3044\u3002<\/span><\/p>\n

<\/p>\n

Option Explicit\r\n\r\nPublic Sub Sample()\r\n  Dim s As String\r\n  \r\n  '\u30c6\u30b9\u30c8\u7528\u6587\u5b57\u5217\u306f http:\/\/ja.wikipedia.org\/wiki\/Microsoft \u3088\u308a\r\n  s = "\u5f53\u521d\u306f\u4e16\u306b\u767b\u5834\u3057\u3066\u9593\u3082\u306a\u30448\u30d3\u30c3\u30c8\u306e\u30de\u30a4\u30af\u30ed\u30d7\u30ed\u30bb\u30c3\u30b5\u3092\u642d\u8f09\u3057\u305f\u30b3\u30f3\u30d4\u30e5\u30fc\u30bf\u300c\u30a2\u30eb\u30c6\u30a2 (Altair)\u300d\u4e0a\u3067\u52d5\u304f\u3001BASIC\u30a4\u30f3\u30bf\u30d7\u30ea\u30bf\u306e\u958b\u767a\u30fb\u8ca9\u58f2\u3067\u6210\u529f\u3092\u53ce\u3081\u305f\u3002" & vbCrLf\r\n  s = s & "\u5f53\u521d\u306f\u30cd\u30a4\u30c6\u30a3\u30d6\u74b0\u5883\uff08\u30ab\u30bb\u30c3\u30c8\u30c6\u30fc\u30d7\u30d9\u30fc\u30b9\u3067\u30aa\u30da\u30ec\u30fc\u30c6\u30a3\u30f3\u30b0\u30b7\u30b9\u30c6\u30e0\u306f\u306a\u304fROM-BASIC\u306b\u8fd1\u3044\u74b0\u5883\u306e\u3082\u306e\uff09\u3060\u3063\u305f\u304c\u3001CP\/M\u304c\u6a19\u6e96\u30d7\u30e9\u30c3\u30c8\u30d5\u30a9\u30fc\u30e0\u3068\u306a\u308b\u3068\u3001CP\/M\u30d9\u30fc\u30b9\u306eMBASIC\u3092\u767a\u8868\u3059\u308b\u3002\u30b0\u30e9\u30d5\u30a3\u30c3\u30af\u30b9\u6a5f\u80fd\u3092\u3064\u3051\u305fGBASIC\u300116\u30d3\u30c3\u30c8\u7528\u306eGWBASIC\u304c\u767b\u5834\u3059\u308b\u3002\u306a\u304a\u3001GW\u306eW\u306f16\u30d3\u30c3\u30c8\u3092\u610f\u5473\u3059\u308b\u30c0\u30d6\u30eb\u30d0\u30a4\u30c8\/\u30ef\u30fc\u30c9\u3060\u3068\u3055\u308c\u3066\u3044\u308b\u3002" & vbCrLf\r\n  s = s & "\u3064\u3044\u3067IBM PC\u4e0a\u306e\u30aa\u30da\u30ec\u30fc\u30c6\u30a3\u30f3\u30b0\u30b7\u30b9\u30c6\u30e0\u306e\u958b\u767a\u3092\u8acb\u3051\u8ca0\u3044\u3001\u30b7\u30a2\u30c8\u30eb\u30b3\u30f3\u30d4\u30e5\u30fc\u30bf\u30d7\u30ed\u30c0\u30af\u30c4\u306e86-DOS\u306e\u6a29\u5229\u3092\u8cfc\u5165\u3057\u6539\u826f\u3001PC DOS\uff08\u81ea\u793e\u30d6\u30e9\u30f3\u30c9\u3067MS-DOS\uff09\u3092\u958b\u767a\u3002IBM PC\u3068\u305d\u308c\u3089\u4e92\u63db\u6a5f\u306e\u666e\u53ca\u3068\u5171\u306b\u30aa\u30da\u30ec\u30fc\u30c6\u30a3\u30f3\u30b0\u30b7\u30b9\u30c6\u30e0\u306e\u9700\u8981\u3082\u4f38\u3073\u3001\u73fe\u5728\u306b\u81f3\u308b\u5730\u56fa\u3081\u3092\u78ba\u304b\u306a\u3082\u306e\u3068\u3057\u305f\u300286-DOS\u306e\u958b\u767a\u8005\u30c6\u30a3\u30e0\u30fb\u30d1\u30bf\u30fc\u30bd\u30f3\u306f\u5f8c\u306b\u30de\u30a4\u30af\u30ed\u30bd\u30d5\u30c8\u306b\u5f15\u304d\u629c\u304b\u308cMS-DOS\u306e\u958b\u767a\u30e1\u30a4\u30f3\u30b9\u30bf\u30c3\u30d5\u3068\u306a\u308b\u3002"\r\n  \r\n  CompareTranslateWebService s '\u65e5\u672c\u8a9e\u304b\u3089\u82f1\u8a9e\r\n  CreateObject("WScript.Shell").Popup "\u51e6\u7406\u304c\u7d42\u4e86\u3057\u307e\u3057\u305f\u3002", , , 64\r\nEnd Sub\r\n\r\nPrivate Sub CompareTranslateWebService(ByVal target As String, Optional ByVal FromLng As String = "ja", Optional ByVal ToLng As String = "en")\r\n'\u7ffb\u8a33\u7d50\u679c\u3092\u6bd4\u8f03\r\n  Dim wapp As Object\r\n  Dim doc1 As Object, doc2 As Object\r\n  Dim ret As String\r\n  Const Cap1 As String = "\u25a0 Yahoo!\u7ffb\u8a33\u7d50\u679c"\r\n  Const Cap2 As String = "\u25a0 Google\u7ffb\u8a33\u7d50\u679c"\r\n  \r\n  '\u5b9f\u884c\u524d\u30c1\u30a7\u30c3\u30af(Yahoo!\u7ffb\u8a33\u306b\u5408\u308f\u305b\u308b)\r\n  '\u6587\u5b57\u6570\u30c1\u30a7\u30c3\u30af(4,000\u6587\u5b57\u307e\u3067)\r\n  If Len(target) >= 4000 Then\r\n    MsgBox "\u7ffb\u8a33\u5bfe\u8c61\u306e\u6587\u5b57\u6570\u304c\u591a\u904e\u304e\u307e\u3059\u3002" & vbCrLf & "\u7ffb\u8a33\u53ef\u80fd\u306a\u6587\u5b57\u6570\u306f4,000\u6587\u5b57\u307e\u3067\u3067\u3059\u3002", vbExclamation + vbSystemModal\r\n    Exit Sub\r\n  End If\r\n  '\u5bfe\u5fdc\u8a00\u8a9e\u30c1\u30a7\u30c3\u30af\r\n  FromLng = LCase$(FromLng)\r\n  Select Case FromLng\r\n    Case "en", "zh", "ko", "fr", "de", "es", "pt", "it", "ja"\r\n    Case Else\r\n      MsgBox "\u672a\u5bfe\u5fdc\u306e\u7ffb\u8a33\u5143\u8a00\u8a9e\u3067\u3059\u3002", vbCritical + vbSystemModal\r\n      Exit Sub\r\n  End Select\r\n  ToLng = LCase$(ToLng)\r\n  Select Case ToLng\r\n    Case "en", "zh", "ko", "fr", "de", "es", "pt", "it", "ja"\r\n    Case Else\r\n      MsgBox "\u672a\u5bfe\u5fdc\u306e\u7ffb\u8a33\u5148\u8a00\u8a9e\u3067\u3059\u3002", vbCritical + vbSystemModal\r\n      Exit Sub\r\n  End Select\r\n  \r\n  '\u7d50\u679c\u8868\u793a\u7528Word\u8d77\u52d5\r\n  Set wapp = CreateObject("Word.Application")\r\n  wapp.Visible = True\r\n  \r\n  'Yahoo!\u7ffb\u8a33\u5b9f\u884c\r\n  ret = TranslateYahoo(target, FromLng, ToLng)\r\n  Set doc1 = wapp.Documents.Add\r\n  doc1.Range.InsertAfter Cap1 & vbCrLf & vbCrLf\r\n  With doc1.Range(0, Len(Cap1)).Font\r\n    .Size = 12\r\n    .Bold = True\r\n  End With\r\n  doc1.Range.InsertAfter ret\r\n  \r\n  'Google\u7ffb\u8a33\u5b9f\u884c\r\n  '\u4e2d\u56fd\u8a9e\u30d1\u30e9\u30e1\u30fc\u30bf\u5bfe\u5fdc\r\n  Select Case FromLng\r\n    Case "zh": FromLng = "zh-CN"\r\n  End Select\r\n  Select Case ToLng\r\n    Case "zh": ToLng = "zh-CN"\r\n  End Select\r\n  ret = "" '\u521d\u671f\u5316\r\n  ret = TranslateGoogle(target, FromLng, ToLng)\r\n  Set doc2 = wapp.Documents.Add\r\n  doc2.Range.InsertAfter Cap2 & vbCrLf & vbCrLf\r\n  With doc2.Range(0, Len(Cap2)).Font\r\n    .Size = 12\r\n    .Bold = True\r\n  End With\r\n  doc2.Range.InsertAfter ret\r\n    \r\n  '\u7d50\u679c\u3092\u4e26\u3079\u3066\u8868\u793a\r\n  wapp.Windows.Arrange wdTiled\r\n  wapp.WindowState = wdWindowStateMinimize\r\n  wapp.WindowState = wdWindowStateNormal\r\nEnd Sub\r\n\r\nPrivate Function TranslateGoogle(ByVal target As String, Optional ByVal FromLng As String = "auto", Optional ByVal ToLng As String = "en") As String\r\n  Dim dat As Variant\r\n  Dim ret As String\r\n  Dim js As String\r\n  Dim itm As Object\r\n  Dim cnt As Long\r\n  Dim sentences, length '\u5c0f\u6587\u5b57\u8868\u793a\u7528\u30c0\u30df\u30fc\r\n  Const url As String = "http:\/\/translate.google.com\/translate_a\/t"\r\n  \r\n  ret = "": js = "": cnt = 1 '\u521d\u671f\u5316\r\n  dat = "client=0&sl=" & FromLng & "&tl=" & ToLng & "&text=" & EncodeURL(target)\r\n  On Error Resume Next\r\n  With CreateObject("MSXML2.XMLHTTP")\r\n    .Open "POST", url, False\r\n    .setRequestHeader "Content-Type", "application\/x-www-form-urlencoded;charset=UTF-8"\r\n    .Send dat\r\n    If .Status = 200 Then js = .responseText\r\n  End With\r\n  On Error GoTo 0\r\n  If Len(js) > 0 Then\r\n    js = "(" & js & ")"\r\n    With CreateObject("ScriptControl")\r\n      .Language = "JScript"\r\n      'Debug.Print .CodeObject.eval(js).sentences.length\r\n      For Each itm In .CodeObject.eval(js).sentences\r\n        If cnt = 1 Then\r\n          ret = ret & itm.trans\r\n        Else\r\n          ret = ret & vbCrLf & itm.trans\r\n        End If\r\n        cnt = cnt + 1\r\n      Next\r\n    End With\r\n  End If\r\n  TranslateGoogle = ret\r\nEnd Function\r\n\r\nPrivate Function TranslateYahoo(ByVal target As String, Optional ByVal FromLng As String = "auto", Optional ByVal ToLng As String = "en") As String\r\n  Dim dat As Variant\r\n  Dim js As String\r\n  Dim ret As String\r\n  Dim url As String\r\n  Dim crumb As String\r\n  Dim itm As Object\r\n  Dim cnt As Long\r\n  Dim ResultSet, ResultText, Results, key, TranslatedText '\u8868\u793a\u7528\u30c0\u30df\u30fc\r\n  \r\n  ret = "" '\u521d\u671f\u5316\r\n  '\u6587\u5b57\u6570\u30c1\u30a7\u30c3\u30af(4,000\u6587\u5b57\u307e\u3067)\r\n  If Len(target) >= 4000 Then\r\n    MsgBox "\u7ffb\u8a33\u5bfe\u8c61\u306e\u6587\u5b57\u6570\u304c\u591a\u904e\u304e\u307e\u3059\u3002" & vbCrLf & "\u7ffb\u8a33\u53ef\u80fd\u306a\u6587\u5b57\u6570\u306f4,000\u6587\u5b57\u307e\u3067\u3067\u3059\u3002", vbExclamation + vbSystemModal\r\n    GoTo Err:\r\n  End If\r\n  '\u5bfe\u5fdc\u8a00\u8a9e\u30c1\u30a7\u30c3\u30af\r\n  FromLng = LCase$(FromLng)\r\n  Select Case FromLng\r\n    Case "auto"\r\n      FromLng = GetPredictLanguage(target)\r\n      If Len(Trim$(FromLng)) < 1 Then\r\n        MsgBox "\u7ffb\u8a33\u5143\u8a00\u8a9e\u306e\u81ea\u52d5\u5224\u5b9a\u306b\u5931\u6557\u3057\u307e\u3057\u305f\u3002" & vbCrLf & "\u51e6\u7406\u3092\u4e2d\u6b62\u3057\u307e\u3059\u3002", vbCritical + vbSystemModal\r\n        GoTo Err:\r\n      End If\r\n    Case "en", "zh", "ko", "fr", "de", "es", "pt", "it", "ja"\r\n    Case Else\r\n      MsgBox "\u672a\u5bfe\u5fdc\u306e\u7ffb\u8a33\u5143\u8a00\u8a9e\u3067\u3059\u3002", vbCritical + vbSystemModal\r\n      GoTo Err:\r\n  End Select\r\n  ToLng = LCase$(ToLng)\r\n  Select Case ToLng\r\n    Case "en", "zh", "ko", "fr", "de", "es", "pt", "it", "ja"\r\n    Case Else\r\n      MsgBox "\u672a\u5bfe\u5fdc\u306e\u7ffb\u8a33\u5148\u8a00\u8a9e\u3067\u3059\u3002", vbCritical + vbSystemModal\r\n      GoTo Err:\r\n  End Select\r\n  \r\n  crumb = "" '\u521d\u671f\u5316\r\n  crumb = GetCrumb()\r\n  If Len(Trim$(crumb)) < 1 Then\r\n    MsgBox "crumb\u306e\u53d6\u5f97\u306b\u5931\u6557\u3057\u307e\u3057\u305f\u3002" & vbCrLf & "\u51e6\u7406\u3092\u4e2d\u6b62\u3057\u307e\u3059\u3002", vbCritical + vbSystemModal\r\n    GoTo Err:\r\n  End If\r\n  \r\n  js = "": cnt = 1 '\u521d\u671f\u5316\r\n  url = "http:\/\/honyaku.yahoo.co.jp\/TranslationText"\r\n  dat = "ieid=" & FromLng & "&oeid=" & ToLng & "&output=json&_crumb=" & crumb & "&p=" & EncodeURL(target)\r\n  On Error Resume Next\r\n  With CreateObject("MSXML2.XMLHTTP")\r\n    .Open "POST", url, False\r\n    .setRequestHeader "Content-Type", "application\/x-www-form-urlencoded;charset=UTF-8"\r\n    .Send dat\r\n    If .Status = 200 Then js = .responseText\r\n  End With\r\n  On Error GoTo 0\r\n  If Len(js) > 0 Then\r\n    js = "(" & js & ")"\r\n    With CreateObject("ScriptControl")\r\n      .Language = "JScript"\r\n      For Each itm In .CodeObject.eval(js).ResultSet.ResultText.Results\r\n        If cnt = 1 Then\r\n          ret = ret & itm.TranslatedText\r\n        Else\r\n          ret = ret & vbCrLf & vbCrLf & itm.TranslatedText\r\n        End If\r\n        cnt = cnt + 1\r\n      Next\r\n    End With\r\n  End If\r\n  \r\nErr:\r\n  TranslateYahoo = ret\r\nEnd Function\r\n\r\nPrivate Function GetCrumb() As String\r\n'TTcrumb\u306e\u5024\u53d6\u5f97\r\n  Dim ret As String\r\n  Dim crumb As String\r\n  Dim v As Variant\r\n  \r\n  crumb = "" '\u521d\u671f\u5316\r\n  On Error Resume Next\r\n  With CreateObject("MSXML2.XMLHTTP")\r\n    .Open "GET", "http:\/\/honyaku.yahoo.co.jp\/transtext\/", False\r\n    .Send\r\n    If .Status = 200 Then ret = .responseText\r\n  End With\r\n  On Error GoTo 0\r\n  If Len(ret) > 0 Then\r\n    With CreateObject("VBScript.RegExp")\r\n      .IgnoreCase = True\r\n      .Global = True\r\n      .Pattern = "id=""TTcrumb"".*(?=""\/>)"\r\n      If .Test(ret) Then\r\n        v = Split(.Execute(ret)(0), """")\r\n        crumb = v(UBound(v))\r\n      End If\r\n    End With\r\n  End If\r\n  GetCrumb = crumb\r\nEnd Function\r\n\r\nPrivate Function GetPredictLanguage(ByVal target As String)\r\n'\u8a00\u8a9e\u81ea\u52d5\u5224\u5b9a\u7d50\u679c\u53d6\u5f97\r\n  Dim d As Object\r\n  Dim ret As String\r\n  Dim url As String\r\n  \r\n  ret = "": Set d = Nothing '\u521d\u671f\u5316\r\n  'url="http:\/\/honyaku.yahoo.co.jp\/LangClassifyService\/V1\/predict_prob?output=json&query="\r\n  url = "http:\/\/honyaku.yahoo.co.jp\/LangClassifyService\/V1\/predict_prob?query=" & EncodeURL(target)\r\n  On Error Resume Next\r\n  With CreateObject("MSXML2.XMLHTTP")\r\n    .Open "GET", url, False\r\n    .setRequestHeader "Content-Type", "application\/x-www-form-urlencoded"\r\n    .Send\r\n    If .Status = 200 Then Set d = .responseXML\r\n  End With\r\n  If Not d Is Nothing Then\r\n    ret = d.SelectSingleNode("\/ResultSet\/Predict").Text\r\n  End If\r\n  On Error GoTo 0\r\n  GetPredictLanguage = ret\r\nEnd Function\r\n\r\nPrivate Function EncodeURL(ByVal sWord As String) As String\r\n  With CreateObject("ScriptControl")\r\n    .Language = "JScript"\r\n    EncodeURL = .CodeObject.encodeURIComponent(sWord)\r\n  End With\r\nEnd Function<\/pre>\n","protected":false},"excerpt":{"rendered":"\u300cGoogle\u7ffb\u8a33\u3067\u6587\u5b57\u5217\u3092\u7ffb\u8a33\u3059\u308b\u30de\u30af\u30ed\u300d\u3068\u300cYahoo!\u7ffb\u8a33\u3067\u6587\u5b57\u5217\u3092\u7ffb\u8a33\u3059\u308b\u30de\u30af\u30ed\u300d\u306e2\u3064\u3092\u5229\u7528\u3057\u3066\u3001Google\u7ffb\u8a33\u3068Yahoo!\u7ffb\u8a33\u3067\u540c\u6642\u306b\u7ffb\u8a33\u3092\u884c\u3046Word\u30de\u30af\u30ed\u3092\u4f5c\u6210\u3057\u3066\u307f\u307e\u3057\u305f\u3002 \u7d50\u679c\u306f\u65b0\u3057\u3044\u6587\u66f8\u306b\u8868\u793a\u3055 […]","protected":false},"author":1,"featured_media":7134,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"_jetpack_newsletter_access":"","_jetpack_dont_email_post_to_subs":false,"_jetpack_newsletter_tier_id":0,"_jetpack_memberships_contains_paywalled_content":false,"_jetpack_feature_clip_id":0,"_jetpack_memberships_contains_paid_content":false,"footnotes":"","jetpack_publicize_message":"","jetpack_publicize_feature_enabled":true,"jetpack_social_post_already_shared":false,"jetpack_social_options":{"image_generator_settings":{"template":"highway","default_image_id":0,"font":"","enabled":false},"version":2},"jetpack_post_was_ever_published":false},"categories":[49,126,50],"tags":[45,47,62],"class_list":["post-1706","post","type-post","status-publish","format-standard","has-post-thumbnail","hentry","category-word-office","category-google","category-translate","tag-word-","tag-google","tag-yahoo"],"aioseo_notices":[],"aioseo_head":"\n\t\t\n\t\n\t\n\t\n\t\n\t\n\t\n\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t