Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Слишком длинный строковый параметр, Требуется исправить готовый макрос
 
Пользователь
Сообщений: 5
Регистрация: 20 Фев 2019
#120 Фев 2019 14:32:17
Всем, Добрый день.

нужна помощь при написании макроса... тема уже заезженная, но подробного ответа так и не нашел... ошибка макроса "слишком длинный строковый параметр"...


Код
Сonst ИмяФайлаШаблона = "Шаблон Протокола.dot"
 КоличествоОбрабатываемыхСтолбцов = 11
Const РасширениеСоздаваемыхФайлов = ".doc"
 
Sub СоздатьПротокол()
   ПутьШаблона = Replace(ThisWorkbook.FullName,ThisWorkbook.Name, ИмяФайлаШаблона)
   НоваяПапка = NewFolderName & Application.PathSeparator
   Dim row As Range, pi As New ProgressIndicator
   r = Cells(Rows.Count, "A").End(xlUp).row: rc = r - 62
   If rc < 1 Then MsgBox "Строк для обработки не найдено",vbCritical: Exit Sub
 
   pi.Show "Формируется протокол оценки": pi.ShowPercents = True: s1 = 10: s2 = 90: p = s1: a = (s2 - s1) / rc
   pi.StartNewAction , s1, "Запуск приложения Microsoft Word"
 
   ' Dim WA As Word.Application, WD As Word.Document: Set WA = New Word.Application    ' c подключением библиотеки Word
   Dim WA As Object, WD As Object: Set WA =CreateObject("Word.Application")    ' без подключениябиблиотеки Word
 
   For Each row In ActiveSheet.Rows("63:" & r)
 With row
     ИмяПротокола = Trim$(.Cells(10))
     Filename = НоваяПапка & ИмяПротокола &РасширениеСоздаваемыхФайлов
 
     pi.StartNewAction p, p + a / 3, "Создание нового файла на основании шаблона", ИмяПротокола
     Set WD = WA.Documents.Add(ПутьШаблона): DoEvents
 
     pi.StartNewAction p + a / 3, p + a * 2 / 3, "Замена данных ...",ИмяПротокола
    For i = 1 To КоличествоОбрабатываемыхСтолбцов
   FindText = Cells(61, i): ReplaceText = Trim$(.Cells(i))
 
   ' так почему-то заменяет не всё (не затрагивает таблицу)
   'WA.Selection.Find.Execute FindText, , , , , , , wdFindContinue, False, ReplaceText, True
 
   pi.line3 = "Заменяется поле " & FindText
   With WD.Range.Find
 .Text = FindText
 .Replacement.Text = ReplaceText
 .Forward = True
 .Wrap = 1
 .Format = False: .MatchCase = False
 .MatchWholeWord = False
 .MatchWildcards = False
 .MatchSoundsLike = False
 .MatchAllWordForms = False
 .Execute Replace:=2
   End With
   DoEvents
     Next i
     pi.StartNewAction p + a * 2 / 3, p + a, "Сохранение файла...", ИмяПротокола, " "
     WD.SaveAs Filename: WD.Close False: DoEvents
     p = p + a
 End With
   Next row
 
   pi.StartNewAction s2, , "Завершение работы приложенияMicrosoft Word", " ", " "
   WA.Quit False: pi.Hide
   msg = "Сформирован " & rc & " протокол оценки. Он находится в папке" & vbNewLine & НоваяПапка
   MsgBox msg, vbInformation, "Готово"
End Sub
 
Function NewFolderName() As String
   NewFolderName = Replace(ThisWorkbook.FullName,ThisWorkbook.Name, "Готовые протоколы по службам")
End Function
 
Function Get_Date() As String: Get_Date = Replace(Replace(DateValue(Now), "/", "-"), ".", "-"): End Function
Function Get_Time() As String: Get_Time = Replace(TimeValue(Now), ":", "-"): End Function
Function Get_Now() As String: Get_Now = Get_Date & " в " &Get_Time: End Function


Пример файлов в приложении пароль архива 54989
 
EvgenTor,  Количество профессионалов, желающих помочь, пропорционально объявленному бюджету.
 
Мой бюджет скромный...500 р я готов отдать за данную работу....и если можно конечно сделать что бы после генерирования шаблона он автоматически открывался...
 
Когда то было написано такое решение проблемы но как это сделать технически не знаю...yangazitov.m, если ругается на Replacement.Text, то вместо .Execute Replace:=2 сделайте цикл: найти - вставить текст, снова найти и т.д. У метода Range.InsertBefore ограничения по длине нет (по крайней мере, строку длиной 5000 можно вставить).
Если не справитесь, приложите файлы, на которых можно отладить код.
 
Есть еще такое решение на др.форумах:
Вот кусок кода, который вылетал с ошибкой, потому что citeEn (наша переменная с текстом) был слишком длинным.

Код
With .Content.Find
   .Text = "#CitationPlaceholder#"
   .Replacement.Text = citeEn 'не больше 255 символов
   .Execute Replace:=wdReplaceAll
End With

Гугл рекомендовал мне рекурсивно разбивать .Replacement.Text на куски по 250 символов и автозаменять друг за другом. Однако громоздкость этого решения меня напугала, поэтому я подумал что лучше бы мне искать текст, выделять его, и заменять выделенное на наш большой текст:

Код
Selection.Find.ClearFormatting
Selection.Find.Execute FindText:="#CitationPlaceholder#", Wrap:=wdFindContinue
If Selection.Find.Found = True Then Selection.Text = citeEn 'много символов

Такой способ позволяет заменить как минимум 900 знаков, а дальше я не проверял.

У меня максимальная длина текста в ячейке составляет 700 знаков.
 
EvgenTor, Профессионалы молчат.  Если устроит не профессионал, то помогу при отсутствии желающих до 9:30 MSK.
 
Не профессионалы устроят тоже)))в нашем деле главное решение проблемы...
 
Отправил в личку решение на проверку.
 
Отправил ответ в личку...
 
После коррекции ( сперва я взял за основу не те файлы :-) )  получен ответ что все работает согласно желанию.
 
Все выполнено по высшему разряду...огромное спасибо пользователю БМФ за оказанную им помощь...
 
Цитата
EvgenTor написал:
огромное спасибо пользователю БМФ
Странно: работу выполнил другой пользователь ))
 
Юрий М, тссс, не палите  :-) ФНС не дремлет.
Страницы: 1
Читают тему (гостей: 1)
Наверх