Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Замена текста из excel в шаблон excel более чем 255 символов - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Замена текста из excel в шаблон excel более чем 255 символов (Формулы/Formulas)
Замена текста из excel в шаблон excel более чем 255 символов
elec2105 Дата: Четверг, 23.09.2021, 12:40 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Добрый день, собрал себе excel документ, который формирует при помощи excel документа - заполненные документы по шаблонов word и excel
Только текст где более 255 символов для замены удалось реализовать при заполнении шаблонов word,
а вот для замены при заполнении шаблонов excel - все рушится. Пробую допилить Function ReplaceText, вот нужна помощь

[vba]
Код
Function ReplaceText(ByVal ID As String, ByVal TextToReplace As String) As Boolean
    Dim i As Long, MaxLen As Long
    Dim Text As String, Mark As String
    Dim iExcel As Object

    MaxLen = 200
    ' Choose a character for Mark that is not in your data,
    '  and is not a special char: ~?*
    Mark = "!"
        If ID <> vbNullString Then
            Do
                Text = Left$(TextToReplace, MaxLen) & Mark
                ' Terminate the loop when all of TextToReplace has been processed
                If Text = Mark Then Text = vbNullString
                TextToReplace = Mid$(TextToReplace, MaxLen + 1)
                iExcel.Sheets(1).Replace _
                What:=ID, _
                Replacement:=Text
                ID = Mark
            Loop Until Text = vbNullString
        End If
End Function
[/vba]

[vba]
Код
Sub CreateDoc()
Dim MyArray(), BasePath As String, iFolder As String, iTemplate As String
Dim tmpArray, tmpSTR As String, iRow As Long, iColl As Long, i As Long, j As Long, q As Long
Dim iExcel As Object

Application.ScreenUpdating = 0
On Error GoTo iEnd

iFolder = Range("FILE_WORD").Value: If Right(iFolder, 1) <> "\" Then iFolder = iFolder & "\"
iTemplate = Range("FILE_TEMPLATE").Value: If Right(iTemplate, 1) = ";" Then iTemplate = Left(iTemplate, Len(iTemplate) - 1)
BasePath = ThisWorkbook.Path & "\Result\": ' Call FolderCreateDel(BasePath)

With Sheets("data")
    iRow = .UsedRange.Row + .UsedRange.Rows.Count - 1: iColl = .UsedRange.Column + .UsedRange.Columns.Count - 1
    MyArray = .Range(.Cells(1, 1), .Cells(iRow, iColl)).Value
End With

'перебираем массив
For i = 2 To iRow
    If MyArray(i, 1) = "ok" Then
    
        'перебираем указанные excel-шаблоны
            tmpSTR = iFolder & tmpArray(q) & ".xlsx"
                If Len(Dir(tmpSTR)) > 0 Then
                    Set iExcel = Workbooks.Open(tmpSTR)
                    'делаем замену переменных
                     For j = 4 To iColl
                        iExcel.Sheets(1).Cells.Replace MyArray(1, j), MyArray(i, j)
                        'Call ReplaceText(MyArray(1, j), MyArray(i, j))
                    Next j
                    
                    iExcel.SaveAs Filename:=BasePath & MyArray(i, 2) & " - " & tmpArray(q) & ".xlsx" '".docx" ', FileFormat:=wdFormatXMLDocument
                    iExcel.Close False: Set iExcel = Nothing
                End If
[/vba]
 
Ответить
СообщениеДобрый день, собрал себе excel документ, который формирует при помощи excel документа - заполненные документы по шаблонов word и excel
Только текст где более 255 символов для замены удалось реализовать при заполнении шаблонов word,
а вот для замены при заполнении шаблонов excel - все рушится. Пробую допилить Function ReplaceText, вот нужна помощь

[vba]
Код
Function ReplaceText(ByVal ID As String, ByVal TextToReplace As String) As Boolean
    Dim i As Long, MaxLen As Long
    Dim Text As String, Mark As String
    Dim iExcel As Object

    MaxLen = 200
    ' Choose a character for Mark that is not in your data,
    '  and is not a special char: ~?*
    Mark = "!"
        If ID <> vbNullString Then
            Do
                Text = Left$(TextToReplace, MaxLen) & Mark
                ' Terminate the loop when all of TextToReplace has been processed
                If Text = Mark Then Text = vbNullString
                TextToReplace = Mid$(TextToReplace, MaxLen + 1)
                iExcel.Sheets(1).Replace _
                What:=ID, _
                Replacement:=Text
                ID = Mark
            Loop Until Text = vbNullString
        End If
End Function
[/vba]

[vba]
Код
Sub CreateDoc()
Dim MyArray(), BasePath As String, iFolder As String, iTemplate As String
Dim tmpArray, tmpSTR As String, iRow As Long, iColl As Long, i As Long, j As Long, q As Long
Dim iExcel As Object

Application.ScreenUpdating = 0
On Error GoTo iEnd

iFolder = Range("FILE_WORD").Value: If Right(iFolder, 1) <> "\" Then iFolder = iFolder & "\"
iTemplate = Range("FILE_TEMPLATE").Value: If Right(iTemplate, 1) = ";" Then iTemplate = Left(iTemplate, Len(iTemplate) - 1)
BasePath = ThisWorkbook.Path & "\Result\": ' Call FolderCreateDel(BasePath)

With Sheets("data")
    iRow = .UsedRange.Row + .UsedRange.Rows.Count - 1: iColl = .UsedRange.Column + .UsedRange.Columns.Count - 1
    MyArray = .Range(.Cells(1, 1), .Cells(iRow, iColl)).Value
End With

'перебираем массив
For i = 2 To iRow
    If MyArray(i, 1) = "ok" Then
    
        'перебираем указанные excel-шаблоны
            tmpSTR = iFolder & tmpArray(q) & ".xlsx"
                If Len(Dir(tmpSTR)) > 0 Then
                    Set iExcel = Workbooks.Open(tmpSTR)
                    'делаем замену переменных
                     For j = 4 To iColl
                        iExcel.Sheets(1).Cells.Replace MyArray(1, j), MyArray(i, j)
                        'Call ReplaceText(MyArray(1, j), MyArray(i, j))
                    Next j
                    
                    iExcel.SaveAs Filename:=BasePath & MyArray(i, 2) & " - " & tmpArray(q) & ".xlsx" '".docx" ', FileFormat:=wdFormatXMLDocument
                    iExcel.Close False: Set iExcel = Nothing
                End If
[/vba]

Автор - elec2105
Дата добавления - 23.09.2021 в 12:40
elec2105 Дата: Пятница, 24.09.2021, 14:51 | Сообщение № 2
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Добрый день!
прошу помочь, хочется выполнять замену по средством команды
[vba]
Код
Call ReplaceText(MyArray(1, j), MyArray(i, j))
[/vba]
где
MyArray(1, j) - текст, который надо заменить
MyArray(i, j) - текст, НА который надо заменить
 
Ответить
СообщениеДобрый день!
прошу помочь, хочется выполнять замену по средством команды
[vba]
Код
Call ReplaceText(MyArray(1, j), MyArray(i, j))
[/vba]
где
MyArray(1, j) - текст, который надо заменить
MyArray(i, j) - текст, НА который надо заменить

Автор - elec2105
Дата добавления - 24.09.2021 в 14:51
elec2105 Дата: Понедельник, 11.10.2021, 11:52 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

Добрый день!
прошу помочь с кодом пожалуйста
 
Ответить
СообщениеДобрый день!
прошу помочь с кодом пожалуйста

Автор - elec2105
Дата добавления - 11.10.2021 в 11:52
Serge_007 Дата: Понедельник, 11.10.2021, 13:32 | Сообщение № 4
Группа: Админы
Ранг: Местный житель
Сообщений: 16475
Репутация: 2748 ±
Замечаний: ±

Excel 2016
Посмотрите здесь: https://stackoverflow.com/questio....h-error


ЮMoney:41001419691823 | WMR:126292472390
 
Ответить
СообщениеПосмотрите здесь: https://stackoverflow.com/questio....h-error

Автор - Serge_007
Дата добавления - 11.10.2021 в 13:32
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Замена текста из excel в шаблон excel более чем 255 символов (Формулы/Formulas)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!