Как перенести форматированный текст из Word в Excel?

Question

Приведенный ниже код копирует данные из MS Word (управление контентом) в Excel. Однако, когда я копирую текст с помощью маркера и вставляю в Excel, он удаляет маркеры и вставляет только текст.

Как скопировать маркеры из элемента управления контентом?

Sub getWordFormData()
Dim wdApp As New Word.Application
Dim myDoc As Word.Document
Dim CCtl As Word.ContentControl
Dim myFolder As String, strFile As String
Dim myWkSht As Worksheet, i As Long, j As Long

myFolder = "enter folder path" '<< enter you folder path for the word document

If Dir(myFolder & "\" & "*.*") = "" Then
    Application.ScreenUpdating = True
    MsgBox "The folder is empty."
    Exit Sub
End If

Set myWkSht = ActiveSheet
ActiveSheet.Cells.Clear
Range("A1") = "Test 1"
Range("B1") = "Test 2"
Range("A1:B1").Font.Bold = True

i = myWkSht.Cells(myWkSht.Rows.Count, 1).End(xlUp).Row
strFile = Dir(myFolder & "\*.docx", vbNormal)

While strFile <> ""
    i = i + 1

    Set myDoc = wdApp.Documents.Open(Filename:=myFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)

    With myDoc
        j = 0
        For Each CCtl In .ContentControls
            j = j + 1
            myWkSht.Cells(i, j) = CCtl.Range.Text
        Next
        myWkSht.Columns.AutoFit
    End With

    myDoc.Close SaveChanges:=False
    strFile = Dir()
Wend

wdApp.Quit
Set myDoc = Nothing: Set wdApp = Nothing: Set myWkSht = Nothing
Application.ScreenUpdating = True

End Sub

Answer 1

попробуйте с этим блоком

With myDoc
    j = 0
    For Each CCtl In .ContentControls
        j = j + 1
        CCtl.Range.Copy
        myWkSht.Cells(i, j).PasteSpecial Paste:=xlPasteValues
    Next
    myWkSht.Columns.AutoFit
End With