Comment copier du texte formaté d'Excel vers un mot en utilisant vba plus rapidement

Question

Problème: Je veux copier du texte formaté d'Excel à mot en utilisant un script excelvba. Le script copie l'information consciencieusement mais trop lentement.

Pouvez-vous m'indiquer comment accélérer les choses, s'il vous plaît?

Mes approches jusqu'à présent sont documentées dans ce document factice. Le script suppose que les cellules C1: C100 contiennent le texte formaté.

Informations générales. J'écris un excelvba makro qui copie des blocs de texte formées dans un document Word. Pour chaque bloc de texte, il existe deux versions. La macro suit les modifications style mot (suppression: texte couleur rouge et barré etc.) et copie le résultat dans une troisième colonne. Cette pièce fonctionne comme un charme. Ensuite, la troisième colonne est copiée dans un document Word. Cette partie fonctionne sur ma machine (i7-3770, ssd, 8 Gb Ram) mais pas sur la machine des âmes pauvres qui doit travailler avec le script (amd Athlon 220) la taille de production est de 700-1000 blocs de texte, avec 100- 1000 caractères chacun.

option explicit 
Sub start() 
Dim wapp As Word.Application 
Dim wdoc As Word.Document 
Set wapp = CreateObject("word.application") 

wapp.Visible = False 
Application.ScreenUpdating = False 

Set wdoc = wapp.Documents.Add 
'Call copyFormattedCellsToWord(wdoc) 
'Call copyFormattedCellsToWordForEach(wdoc) 
'Call copyWholeRange(wdoc) 
Call concatenateEverythingInAStringAndCopy(wdoc) 
wapp.Visible = True 
End Sub 

'desired output-result (every cell in a new line and formatting preserved) meets the specs, but to slow 

Sub copyFormattedCellsToWord(wdoc As Word.Document) 

Dim counter As Long 

Worksheets(1).Select 
For counter = 1 To 100 
     Worksheets(1).Range("C" & counter).Copy 
     wdoc.Range(wdoc.Range.End - 1, wdoc.Range.End).PasteSpecial Placement:=wdInLine, DataType:=wdPasteHTML 
Next counter 

End Sub 

'desired output-result, a tiny bit faster (might be only superstition), but still not fast enough 

Sub copyFormattedCellsToWordForEach(wdoc As Word.Document) 

Dim cell As Range 

Worksheets(1).Select 
For Each cell In Worksheets(1).Range("C1:C100") 
     cell.Copy 
     wdoc.Range(wdoc.Range.End - 1, wdoc.Range.End).PasteSpecial Placement:=wdInLine, DataType:=wdPasteHTML 
Next cell 

End Sub 

'fast enough, but introduces a table in the word document and therefore 
'doesn't meet the specs 

Sub copyWholeRange(wdoc As Word.Document) 

Worksheets(1).Range("C1:C100").Copy 
wdoc.Range(wdoc.Range.End - 1, wdoc.Range.End).PasteSpecial Placement:=wdInLine, DataType:=wdPasteHTML 

End Sub 

'fast enought, looses the formatting 


Sub concatenateEverythingInAStringAndCopy(wdoc As Word.Document) 

Dim wastebin As String 
Dim cell As Range 

wastebin = "" 
Worksheets(1).Select 
For Each cell In Worksheets(1).Range("C1:C100") 
     wastebin = wastebin & cell.Value 
Next cell 
Range("D1") = wastebin 
Range("D1").Copy 
wdoc.Range(wdoc.Range.End - 1, wdoc.Range.End).PasteSpecial Placement:=wdInLine, DataType:=wdPasteHTML 

End Sub 

Answer 1

méthode Modifier vous copyWholeRange ainsi:

Sub copyWholeRange(wdoc As Word.Document) 

    Worksheets(1).Range("C1:C10").Copy 
    wdoc.Range(wdoc.Range.End - 1, wdoc.Range.End).PasteSpecial Placement:=wdInLine, DataType:=wdPasteHTML 

    wdoc.Tables(1).ConvertToText Separator:=wdSeparateByParagraphs 
End Sub