[英]How to copy formatted text from excel to word using vba faster
Problem: I want to copy formated text from excel to word using a excelvba-script. 问题:我想使用excelvba脚本将格式文本从excel复制到单词。 The script copies the information dutifully but too slowly. 该脚本会忠实地复制信息,但速度太慢。
Can you give me a hint how to speed things up, please? 请给我提示如何加快速度吗?
My approaches so far a documented in this dummy-document. 到目前为止,我的方法已记录在该虚拟文档中。 The script assumes, that cells C1:C100 contain the formated text. 该脚本假定单元格C1:C100包含格式化的文本。
General information. 一般信息。 I am writing a excelvba makro that copies formated text blocks to a word document. 我正在写一个excelvba makro,它将格式化的文本块复制到Word文档中。 For each textblock there a two versions. 每个文本块都有两个版本。 The macro tracks the changes word-style.(Deletion: textcolor red and strikethrough etc.) and copies the result to a third colum. 宏会跟踪单词样式的更改(删除:文本颜色为红色和删除线等),然后将结果复制到第三列。 This part works like a charm. 这部分的工作原理很像魅力。 Then the third column is copied to a word document. 然后将第三列复制到Word文档。 This part works on my machine (i7-3770, ssd, 8 Gb Ram) but not on the poor souls machine who has to work with the script (amd Athlon 220) the production size is 700-1000 textblocks, with 100-1000 characters each. 这部分在我的机器(i7-3770,ssd,8 Gb Ram)上工作,但在必须使用脚本(amd Athlon 220)的可怜灵魂的机器上不起作用,生产大小为700-1000个文本块,具有100-1000个字符每。
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
Modify you copyWholeRange
method in this way: 以这种方式修改您的copyWholeRange
方法:
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.