Страницы: 1
RSS
Слишком длинный строковый параметр
 
Всем, Добрый день.

нужна помощь при написании макроса... тема уже заезженная, но подробного ответа так и не нашел... ошибка макроса "слишком длинный строковый параметр"...
Код
С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 написал:
огромное спасибо пользователю БМФ
Странно: работу выполнил другой пользователь ))
 
Юрий М, тссс, не палите  :-) ФНС не дремлет.
По вопросам из тем форума, личку не читаю.
 
Цитата
EvgenTor написал:
Все выполнено по высшему разряду...огромное спасибо пользователю БМФ за оказанную им помощь...
Подскажите решение. Буду очень благодарен.
 
Stepchin Stepchin, в платной ветке возможен только поиск исполнителя (в собственной, а не чужой теме)
Если задача не комплексная, то задайте вопрос в бесплатной ветке с нормальным примером и названием темы
Изменено: Jack Famous - 11.06.2020 11:21:20
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Stepchin Stepchin написал:
Подскажите решение. Буду очень благодарен.
Опустите еще одну монетку :-) . НО если серьезно, то лично я и не помню что делал.
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ написал:
Количество профессионалов, желающих помочь, пропорционально объявленному бюджету
Притяжение, как известно, пропорционально квадрату бюджета. :)  
Владимир
 
<vb>
Function ExportWord(ByVal iName As String, ByVal iVal As String) As Boolean
   Dim i As Long
   
   'îñóùåñòâëÿåì çàìåíó òåêñòà â îñíîâíîé äîêóìåíòå
   With iWord.Content.Find                'With ActiveDocument.Content.Find
       .ClearFormatting
       .Replacement.ClearFormatting
       '.Replacement.Style = ActiveDocument.Styles("Çàãîëîâîê 2 Çíàê")  'Âîçâðàùàåò èëè óñòàíàâëèâàåò ñòèëü îáúåêòà.
       .Text = iName
       .Replacement.Text = iVal
       .Forward = True                  
       .Wrap = 1                        
       .Format = False                    
       .MatchCase = True                  
       .MatchWholeWord = True              
       .MatchAllWordForms = False    
       .MatchSoundsLike = False          
       .MatchWildcards = False            

       'MatchByte                    
       'ParagraphFormat                  
       'Found                            
       'Font                              
       
       '.Execute Replace:=wdReplaceAll
       .Execute
       
       If .Found Then
           ExportWord = True          
           .Execute Replace:=2        
       Else
           ExportWord = False        
       End If
   End With

End Function
</vb>
Нашел код но выдает ошибку слишком длинный строковый параметр в интернете много решений но незнаю как правильно вставить в этот код.Сам перепробовал но ошибка сохраняется
 
Radeon, Вы  предлагаете оплачиваемую работу?
Страницы: 1
Наверх