Скопировать форматирование текста в excel в текстовый скрипт

Question

У меня есть действующий скрипт, он копирует целевой текст из листа Excel в открытый документ Word, но мне интересно, возможно ли, что он также копирует форматирование текста, что означает текст: Полужирный и подчеркнутый. В настоящее время он просто копирует текст в слово.

Sub Updated_Excel_Data_to_Word() 
    Dim rYes As Range, r As Range 
    Dim sData As String 
    Dim tData As String 
    Dim uData As String 
    Dim objWord As Object 


    Set rYes = Range("B2:B34") 


    For Each r In rYes 
     If r = "X" Then 

      sData = sData & r.Offset(0, 1) & Chr(13) 
     End If 
    Next r 


    Set rYes = Range("F2", Range("F" & Rows.Count).End(xlUp)) 


    For Each r In rYes 
     If r = "X" Then 

      tData = tData & r.Offset(0, 1) & Chr(13) 
     End If 
    Next r 



    Set rYes = Range("J2", Range("J" & Rows.Count).End(xlUp)) 


    For Each r In rYes 
     If r = "X" Then 

      uData = uData & r.Offset(0, 1) & Chr(13) 
     End If 
    Next r 





    Set objWord = GetObject(, "word.application") 

    objWord.activeDocument.Bookmarks("One").Select 
    objWord.Selection.TypeText (sData) 
    objWord.activeDocument.Bookmarks("Two").Select 
    objWord.Selection.TypeText (tData) 
    objWord.activeDocument.Bookmarks("Three").Select 
    objWord.Selection.TypeText (uData) 
End Sub 

Answer 1

Да, я думаю, что это должно быть возможно, но для вашего кода требуются некоторые структурные изменения. Вам нужно будет воспроизвести операцию «вставить» в Word, а не (как вы сейчас делаете), только необработанный текст в ваших sData, tData, uData переменных.

Давайте также очистим это с помощью дополнительной подпрограммы, так как вы повторяете цикл For Each r над несколькими различными объектами диапазона.

Sub Updated_Excel_Data_to_Word() 

    Dim rYes As Range 
    Dim objWord As Object 

    ' Get a handle on Word Application 
    Set objWord = GetObject(, "word.application") 

    ' Assign the range 
    Set rYes = Range("B2:B34") 

    ' Pass the range and Word object variables to the helper function 
    Call PasteValuesToWordBookmark(rYes, objWord, _ 
            objWord.activeDocument.Bookmarks("One")) 

    ' repeat as needed, just changing the range & bookmarks 
    Set rYes = Range("F2", Range("F" & Rows.Count).End(xlUp)) 

    Call PasteValuesToWordBookmark(rYes, objWord, _ 
            objWord.activeDocument.Bookmarks("Two")) 

    Set rYes = Range("J2", Range("J" & Rows.Count).End(xlUp)) 

    Call PasteValuesToWordBookmark(rYes, objWord, _ 
            objWord.activeDocument.Bookmarks("Three")) 

End Sub 

Sub PasteValuesToWordBookmark(rng as Range, wdApp as Object, _ 
           wdBookmark as Object) 
    Dim r as Range 

    For Each r In rng 
     If r = "X" Then 
      wdBookmark.Select 
      r.Offset(0, 1).Copy 'Copy the cell from Excel 
      'in my testing this automatically adds a carriage return, so 
      ' we don't need to explicitly append the Chr(13)/vbCR character 
      wdApp.CommandBars.ExecuteMSO "PasteSourceFormatting" 
     End If 
    Next r 

End Sub 

Вот пример вывода, который сохранил все форматирование текста (жирный шрифт, подчеркивание, цвет шрифта и т.д.)

Это должно работать во всех приложениях Office (см here для аналогичного Q & A относительно Excel-> PowerPoint), и, как уже упоминалось:

CommandBars.ExecuteMso не очень хорошо документирован по сравнению со многими другими способами. Application.CommandBarsproperty reference даже не говоря уже о ExecuteMso метод, который я нашел некоторую информацию о здесь:

http://msdn.microsoft.com/en-us/library/office/ff862419(v=office.15).aspx

Этот метод полезен в тех случаях, когда нет объектной модели для конкретной команды. Работает с элементами управления, которые являются встроенными кнопками, toggleButtons и splitButtons.

Вам нужен список idMso параметров для изучения, которые приходят как часть довольно большого загружаемого файла, в настоящее время для офиса 2013 Я считаю:

http://www.microsoft.com/en-us/download/details.aspx?id=727