Страницы: 1
RSS
Управление редактором формул в Word из VBA Excel, Проблема с заполнением значений в Word из Excel
 
Уважаемые форумчане, зная вашу отзывчивость, хочу попросить помочь с решением проблемы, которую я не могу решить с помощью "Поиска".
Суть проблемы такова:
я, пользуясь кодом с форума, заполняю шаблон в Word из Excel. Всё бы хорошо, но не получается заполнить значения, которые записаны в редакторе формул.
К сообщению прилагаю архив с 3-мя файлами : Пример в Excel с макросом, Пример в Word и результат работы макроса.
Код
Sub ReplaceInWord()

    'Отключаем обновление экрана
    Application.ScreenUpdating = False
    'имя шаблона Word с основным текстом и метками
    Const sWDTmpl As String = "Пример.docx" 'Шаблон оформления
    
    Dim objWrdApp As Object, objWrdDoc As Object, wdRange As Object
    Dim IsNeedClose As Boolean
    Dim wsOformlenie As Worksheet
    Dim lr As Long, llastr As Long, lc As Long, llastc As Long
    Dim sPath As String, sToSavePath As String, sWDTmplFullName As String, sWDDocName As String
    Dim sFindVal As String, sReplaceVal As String
    On Error Resume Next
    'пытаемся подключится к объекту Word
    Set objWrdApp = GetObject(, "Word.Application")
    If objWrdApp Is Nothing Then
        'если приложение закрыто - создаем новый экземпляр
        Set objWrdApp = CreateObject("Word.Application")
        'делаем приложение видимым. По умолчанию открывается в скрытом режиме
        objWrdApp.Visible = True
        IsNeedClose = True
    End If
    'путь к папке с файлом кода
    'здесь же должен лежать файл шаблона Word
    sPath = ThisWorkbook.Path
    'добавляем разделитель папок, если его нет
    sPath = IIf(Right(sPath, 1) = Application.PathSeparator, "", sPath & Application.PathSeparator)
    'полный путь к файлу шаблона
    sWDTmplFullName = sPath & sWDTmpl
    'создаем папку для сохранения создаваемых файлов Word
    sToSavePath = sPath & Format(Now, "YYYY_MM_DD hh_mm")
    If Dir(sToSavePath, 16) = "" Then
        MkDir sToSavePath
    End If
    sToSavePath = IIf(Right(sToSavePath, 1) = Application.PathSeparator, "", sToSavePath & Application.PathSeparator)
    
    Set wsOformlenie = Worksheets("Лист1")
    With wsOformlenie
        'определяем последнюю заполненную ячейку на основании столбца А
        llastr = .Cells(.Rows.Count, 1).End(xlUp).Row
        'определяем последний столбец на основании столбца с метками
        llastc = .Cells(1, .Columns.Count).End(xlToLeft).Column
        'просмотр начинаем с 3-ей строки, т.к. именно с неё начинаются наши данные
        For lr = 3 To llastr
            'считываем Шифр (Впоследствии заменить на наименование объекта)
            sWDDocName = .Cells(lr, 1).Value
            If sWDDocName <> "" Then
                'заменяем точки на пусто для удобочиатемости имен файлов
'                sWDDocName = Replace(sWDDocName, ".", "")
                'составляем полный путь к создаваемому файлу,
                'при этом берем тоже расширение файла, что и шаблона
                sWDDocName = sToSavePath & sWDDocName & ".doc"
                'создаем новый документ Word на основании шаблона
                Set objWrdDoc = objWrdApp.Documents.Add(sWDTmplFullName)
                For lc = 1 To llastc
                    'запоминаем метку для поиска в файле Word
                    sFindVal = .Cells(1, lc).Value
                    'этим значением будем заменять текст метки
                    sReplaceVal = .Cells(lr, lc).Text
                    Set wdRange = objWrdDoc.Range
                    'заменяем метки {*} на текст из ячеек
                    wdRange.Find.ClearFormatting
                    wdRange.Find.Replacement.ClearFormatting
                    With wdRange.Find
                        .Text = sFindVal
                        .Replacement.Text = sReplaceVal
                        .Forward = True
                        .Wrap = 1 'wdFindContinue
                        .Format = False
                        .MatchCase = False
                        .MatchWholeWord = False
                        .MatchWildcards = False
                        .MatchSoundsLike = False
                        .MatchAllWordForms = False
                    End With
                    wdRange.Find.Execute Replace:=2 'wdReplaceAll
                Next lc
                
    'сохраняем созданный документ, но не добавляем в список последних открытых
    objWrdDoc.SaveAs Filename:=sWDDocName, AddToRecentFiles:=False
    'закрываем документ Word
    objWrdDoc.Close False
            End If
        Next
    End With
    If IsNeedClose Then
        'закрываем приложение Word если открывали его кодом
        objWrdApp.Quit
    End If
    'очищаем переменные Word
    Set objWrdDoc = Nothing
    Set objWrdApp = Nothing
    
    'Обновляем экран
    Application.ScreenUpdating = True
    '
    MsgBox "Файлы созданы и сохранены в папке '" & sToSavePath
End Sub
 
Off

По сути вопроса: стандартная замена не работает внутри редактора формул. А использовать редактор формул в данной ситуации не такая уж простая задача. Я бы на Вашем месте просто записал выражения обычным текстом, отформатировав их максимально "по феншую". Если, конечно, при этом не надо их еще и вычислять...
Изменено: Дмитрий(The_Prist) Щербаков - 07.07.2022 12:10:52
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий, да конечно, это же Ваш код!
Спасибо за ответ!
Страницы: 1
Наверх