我在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