VBA для копирования ячеек Excel в Word с определенным форматированием - PullRequest
0 голосов
/ 28 января 2019

У меня есть ячейки в столбце C с подсказками для кода, чтобы применить определенное форматирование при копировании из Excel в Word.В столбце C есть, например, слово «title» = ячейка C14.Мой код должен скопировать ячейку B14 в Word с форматированием «Заголовок 1».Тогда у меня есть «par» в ячейке C16, код должен скопировать B16 с форматированием «Normal» и т. Д.

Я придумал это решение, но оно ничего не копирует.Я думаю, что проблема с .TypeText Text:=.Range(0, -1).Text?Я пробовал разные варианты без успеха.

Option Explicit

    Sub main()


        Dim objWord As Object
        Dim objDoc As Object
        Dim objSelection As Object
        Dim Cell as Range


        Set objWord = CreateObject("Word.Application") '<--| get a new instance of Word
        Set objDoc = objWord.Documents.Add '<--| add a new Word document
        objWord.Visible = True
        Set objSelection = objDoc.ActiveWindow.Selection '<--| get new Word document 'Selection' object

        With objSelection '<--| reference 'Selection' object

    For Each cell In ThisWorkbook.Worksheets("Offer Letter").Range("C1", ThisWorkbook.Worksheets("Offer Letter").Range("C" & Rows.Count).End(xlUp))
         Select Case LCase(cell.Value)
        Case "title"
                    .TypeParagraph
                    .Style = objWord.ActiveDocument.Styles("Heading 1")
                    .TypeText Text:=.Range(0, -1).Text
            Case "par"
                    .TypeParagraph
                    .Style = objWord.ActiveDocument.Styles("Normal")
                    .TypeText Text:=.Range(0, -1).Text
          End Select
       Next cell

        End With

        objDoc.SaveAs2 ActiveWorkbook.Path & "\" & Sheets("Other Data").Range("AN2").Value & ", " & Sheets("Other Data").Range("AN7").Value & "_" & Sheets("Other Data").Range("AN8").Value & "_" & Sheets("Other Data").Range("AX2").Value & ".docx" '<--| save your word document

        objWord.Quit '<--| quit Word
        Set objWord = Nothing '<--| release object variable
    End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...