VBA to copy Excel cells to Word with certain formatting

[mrwad]

I have cells in Column C with tool tips for code to apply certain formatting while copying from Excel to Word. In Column C there is for example word "title" = cell C14. My code should copy cell B14 to Word with formatting of "Heading 1". Then I have "par" in cell C16 code should copy B16 with formatting of "Normal" etc.


I came up with this solution but it is not copying anything. I think the problem is with

.TypeText Text:=.Range(0, -1).Text?

I have been trying different variants with no success.

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:=cell.Range(0, -1).Text
            Case "par"
                    .TypeParagraph
                    .Style = objWord.ActiveDocument.Styles("Normal")
                    .TypeText Text:=cell.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

https://stackoverflow.com/questions...matting?noredirect=1#comment95617580_54403354

 

[Norie]

Change Range(0, -1) to Offset(,-1).