Новости:

К первому сообщению темы должен быть прикреплен файл примера в формате xls*.
Приложив пример, Вы избавите себя и других от вопросов типа "А какой критерий?", "А куда выводить результат?", "А сколько строк?" и все тех же просьб выложить файл. Рисовать за Вас Ваши же таблички с заданиями, а затем и решение к ним, никто желанием не горит. Да и, как показывает практика, в большинстве случаев без файла решения не найти.

Главное меню

Создание обьектов в редакторе формул Word из VBA Excel

Автор Windo, 18.06.2015, 19:30

« назад - далее »

Windo

Нужно создать формулу из VBA Excel в редакторе формул Word  и заполнить  ее значениями с листа excel. Возникает ошибка на шаге .Selection.OMaths.Add Range:=Selection.Range  , что я делаю не так?

Sub создание_Doc()

DiSub Ñîçäàòü_Doc()

Dim sPath As String

Dim objWord As Object
Set objWord = CreateObject("Word.Application")
 
  objWord.Documents.Add DocumentType:=wdNewBlankDocument
  objWord.Visible = True

Range([A7], Range("G" & Rows.Count).End(xlUp)).Copy

strForWho = ActiveSheet.Cells(3, 1).Value
strForWhy = ActiveSheet.Cells(5, 2).Value

With objWord

.Selection.OMaths.Add Range:=Selection.Range  'возникает ошибка

End With

'Application.GetSaveAsFilename
'sPath = Application.GetSaveAsFilename

objWord.Activate

Application.CutCopyMode = False
End Sub

Windo

#1
Нашел способ, не до конца рабочий, не забываем включать объекты word  (VBA-tools- referenses).
создает поле, но формулы не вставляются ...

Sub Doc() ' создание Doc

     
   
     Dim objRange As Object
     Dim objMath As OMath
     Dim sPath As String

Dim objWord As Object
Set objWord = CreateObject("Word.Application") ' создание обьекта Word
 
  objWord.Documents.Add DocumentType:=wdNewBlankDocument
  objWord.Visible = True

Range([A7], Range("G" & Rows.Count).End(xlUp)).Copy

strForWho = ActiveSheet.Cells(3, 1).Value
strForWhy = ActiveSheet.Cells(5, 2).Value

With objWord
   With .Selection
                .Font.Size = 12
                .ParagraphFormat.Alignment = 0
                .Font.Bold = False
                .TypeText Text:="text"
                .TypeParagraph
                 Set objRange = .Range
                 Set objRange = .OMaths.Add(objRange)
                 Set objRange = .OMaths.Functions.Add(Selection.Range, wdOMathFunctionFrac). _
        Frac.Type = wdOMathFracBar
End With
End With
'Application.GetSaveAsFilename
'sPath = Application.GetSaveAsFilename

objWord.Activate

'objWord.ActiveDocument.SaveAs2 (ActiveWorkbook.Path & "\Vopr.doc")
'objWord.ActiveDocument.SaveAs Filename:=myPath, FileFormat:=wdFormatXMLDocument

Application.CutCopyMode = False
End Sub



Нужно чтобы такой код из Word VBA работал в верхнем макросе excel VBA.
ВКЛЮЧЕНИЕ РЕЖИМА ФОРМУЛ
    Selection.OMaths.Add Range:=Selection.Range
   
'СОЗДАЕМ ПРЯМЫЕ СКОБКИ
    With Selection.OMaths(1).Functions.Add(Selection.Range, _
        wdOMathFunctionDelim, 1)
        .Delim.BegChar = 124
        .Delim.SepChar = 0
        .Delim.EndChar = 124
        .Delim.Grow = True
        .Delim.Shape = wdOMathShapeCentered
    End With


'ДЕЛАЕМ 1 ШАГ НАЗАД
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
   
   
'СОЗДАЕМ МАТРИЦУ 4Х4
    Selection.OMaths(1).Functions.Add(Selection.Range, wdOMathFunctionMat, 16, _
        4).Mat.PlcHoldHidden = False
    Selection.MoveLeft Unit:=wdCharacter, Count:=17
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:="1"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:="2"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:="3"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:="4"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:="5"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:="6"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:="7"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:="8"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:="9"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:="10"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:="11"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:="12"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:="13"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:="14"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:="15"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:="16"
    Selection.MoveRight Unit:=wdCharacter, Count:=2
   
   
'СТАВИМ ЗНАК РАВЕНСТВА
    Selection.TypeText Text:="="
    Selection.MoveRight Unit:=wdCharacter, Count:=1
       
       
'СТАВИМ СТЕПЕННУЮ ФУНКЦИЮ
    Selection.OMaths(1).Functions.Add Range:=Selection.Range, Type:= _
        wdOMathFunctionScrSup
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.TypeText Text:="2"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:="3"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
   

   
   
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
End Sub