VBA以特定格式将Excel单元格复制到Word

时间:2019-01-28 13:45:22

标签: excel vba ms-word

我在C列中具有一些单元格,这些单元格带有工具提示,用于代码在从Excel复制到Word时应用某些格式。在列C中,例如,单词“标题” =单元格C14。我的代码应将单元格B14复制到Word,格式为“标题1”。然后我在单元格C16中有“ par”代码,应复制格式为“ Normal”等的B16。

我想出了这个解决方案,但它没有复制任何内容。我认为问题出在.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

0 个答案:

没有答案