Exploit Васильевич
Участник
- Сообщения
- 77
- Реакции
- 10
Это можно сделать с помощью ABBYY FineReader, правда программа платная.есть каталог(700страниц) в PDF, который нужно перенести в эксель(CVS),
этот пункт не понятен.некоторые записи в таблицах каталога нужно Перевести на другой язык
не понятно, что именно вы хотите делать VB ?2 Хватит ли для этого встроенного в эксель VBA?
а он комп умеет включть??)1 Насколько выполнима эта задача для неподготовленного человека?
а зачем он??2 Хватит ли для этого встроенного в эксель VBA?
ну переводами явно не ексель занимается...Перевести на другой язык
перевести PDF в эксель, с этим прекрасно справится ABBYY FineReader
этот пункт не понятен.
Этот вопрос я уже решил, остался вопрос с переводом.Это можно сделать с помощью ABBYY
а зачем он??
Исходная таблица содержит в первой колонке иероглифы для перевода, а конечная перевод с необходимым форматированием ( Названия полей – первая строка.Дайте пример исходной структуры Excel или CSV-файла, а также несколько строк для перевода (прикрепите файл в архиве ZIP к сообщению
Да, я специально так сделал.как это исправить?
Sub Перевести()
'Application.ScreenUpdating = False 'ускорение вывода на экран (отключение обновления экрана)
LastCell = Cells(Rows.Count, 1).End(xlUp).Row 'поиск последней заполненной ячейки в столбце 1
Progress.Show 0 'показать форму Progress
For y = 1 To LastCell 'цикл перебора от 1 до последней заполненной ячейки
Progress.Label1.Caption = String(Int(y / LastCell * 70) + 1, "|") 'обновление количества "палок" в прогрессбаре
'обновить форму,
Progress.Repaint
' разгрузить ресурсы ЦПУ, отдав их большую часть другим программам, чтобы не вызывать зависания
DoEvents
With Cells(y, 1)
.Activate 'перейти к ячейке с координатами { y,1 }
'если кол-во одиночных ячеек в объединенной области превышает 1
'иначе говоря - если ячейки объединены
If .MergeArea.Cells.Count > 1 Then
If Len(.Value) <> 0 Then 'если значение непустое (если длина значения > 0)
s = ModFunc.Translate(.Value, "en", "ja") 'вызвать функцию Translate из модуля ModFunc
If Len(s) <> 0 Then .Value = s 'если вернула непустое значение, присвоить ячейке { y,1 } это значение
End If
End If
End With
Next
Unload Progress 'выгрузить форму прогрессбара
Application.ScreenUpdating = True 'включить обновление экрана
End Sub
'собственно сама функция - ей передаются по значению аргументы:
' 1) текст для перевода
' 2) язык, на который нужно перевести
' 3) исходный язык (опционально), иначе - автоопределение Googl-ом
Function Translate$(ByVal TextToBeTranslated$, ByVal resultLanguageCode$, _
Optional ByVal sourceLanguageCode$ = "")
On Error Resume Next 'игнорирование любых критических ошибок при выполнении кода
' переводит текст TextToBeTranslated$ с языка sourceLanguageCode$
' на язык resultLanguageCode$, используя сервис переводов Google Translate
' Application.Volatile True 'форсировать автообновление формул
Set ADOStream = CreateObject("ADODB.Stream") 'создаем экземпляр объекта ADO.Stream
' часть ниже преобразовует в UTF-8 без BOM (хидера) текст для перевода
With ADOStream
'кодировка - UTF-8, режим работы - adModeReadWrite (чтение и запись), тип данных - 2 - текст
.Charset = "utf-8": .Mode = 3: .Type = 2: .Open
'записываем в поток текст, обновляем, устанавливаем позицию курсора в 0
.WriteText TextToBeTranslated: .Flush: .Position = 0
'переключаем тип на бинарный, читаем первые 3 байта (таким образом игнорируем их)
'читаем в переменную остальную часть, закрываем поток
.Type = 1: .Read 3: ByteArrayToEncode = .Read(): .Close
End With
' Эта часть пробразовует текст в URL-Encode
For i = 0 To UBound(ByteArrayToEncode)
iAsc = ByteArrayToEncode(i)
Select Case iAsc ' переводим текст в кодировку, понятную Google
Case 32: sTemp$ = "+" 'space
Case 48 To 57, 65 To 90, 97 To 122: sTemp$ = Chr(ByteArrayToEncode(i))
Case Else: sTemp$ = "%" & Hex(iAsc) 'Chr(iAsc)
End Select
txt$ = txt$ & sTemp$
Next
' формируем ссылку, по которой Google выдаст нам файл с переводом
URL$ = "http://translate.google.com.ua/translate_a/t?client=json&text=" & _
txt$ & "&hl=" & resultLanguageCode$ & "&sl=" & sourceLanguageCode$
Set XMLHTTP = CreateObject("Microsoft.XMLHTTP") ' скачиваем файл
' Отправляем GET-запрос
XMLHTTP.Open "GET", Replace(URL$, "\", "/"), "False": XMLHTTP.send
If XMLHTTP.statustext = "OK" Then
LocalPath$ = Environ("TMP") & "\google.txt"
With ADOStream ' перекодировка файла
.Type = 1: .Open: .Write XMLHTTP.responseBody
' сохраняем ответ сайта во временный файл
.SaveToFile LocalPath$, 2
.Close: .Type = 2: .Charset = "utf-8": .Open:
.LoadFromFile LocalPath$ ' загружаем данные из файла
Translate$ = .ReadText ' считываем текст файла в переменную Translate$
End With
' часть выше написана ущербно - можно было обойтись и без временного файла
On Error Resume Next
' вырезаем нужный текст из ответа, находя параметр "trans" и "orig"
Translate$ = Split(Translate$, """trans"":""")(1)
Translate$ = Split(Translate$, """,""orig")(0)
Translate$ = Replace(Translate$, "quot;", Chr(39))
If Translate$ = " null, " Then Translate$ = "Не переведено"
End If
Set XMLHTTP = Nothing: Set ADOStream = Nothing 'очищаем объекты
End Function
'функция определяет является ли хоть один символ в строке юникодным (китайским/ японским) (все, до чего смог додуматься за пару мин. :))
Function isIeroglif(s As String)
'Перечисляем каждый символ в слове
For n = 1 To Len(s)
' получаем двухбайтный код символа
i = AscW(Mid(s, n, 1))
' если код выше 255 или ниже 0, то это юникод -> выходим из функции
If (i > 255) Or (i < 0) Then isIeroglif = True: Exit Function
Next
End Function
We use cookies and similar technologies for the following purposes:
Do you accept cookies and these technologies?
We use cookies and similar technologies for the following purposes:
Do you accept cookies and these technologies?