vba 从excel粘贴到word文档
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/6310258/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
提示：将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间：2020-09-08 11:34:47 来源:igfitidea点击:
pasting from excel into a word document
提问by l--''''''---------''''''''''''
i am copying cells from excel into an open word document. the way i am doing this is just copying the contents of a cell into the clipboard and REPLACING a specific KEYWORD in the word document like so:
我正在将 Excel 中的单元格复制到一个打开的 Word 文档中。我这样做的方式只是将单元格的内容复制到剪贴板并替换 word 文档中的特定关键字，如下所示：
if cell A1 = "some word"i need too replace the string "QUERYA1" in the word document
如果单元格A1 = "some word"我也需要替换QUERYA1单词文档中的字符串“ ”
i am doing it like this:
我这样做：
Sub NoFormatPaste()
wdFind.Replacement.Text = ""
wdFind.Forward = True
wdFind.Wrap = wdFindContinue
wdFind.Execute
If IsEmpty(Selection.Text) And Len(Selection.Text) = 0 Then
ClipEmpty.PutInClipboard
appWd.Selection.PasteSpecial DataType:=wdPasteText
End
Else
appWd.Selection.PasteSpecial DataType:=wdPasteText
End If
CutCopyMode = False
End Sub
when this sub runs, it works on every field except it gives an error if the cell is empty. i have this formula in the cell: =+IF(K10="XXX","",K10)
当这个子运行时，它适用于每个字段，除非它在单元格为空时给出错误。我在单元格中有这个公式：=+IF(K10="XXX","",K10)
when this formula yields NOTHING or a blank, and i run my macro, i get an error on PASTING this into word. i am getting an error called 4168 command failed/command executionon this line:
当此公式不产生任何内容或空白时，并且我运行我的宏时，将其粘贴到 word 时出现错误。我4168 command failed/command execution在这条线上收到一个错误：
appWd.Selection.PasteSpecial DataType:=wdPasteText
here is my complete code:
这是我的完整代码：
Dim appWd As Word.Application
Dim wdFind As Object
Dim ClipEmpty As New MSForms.DataObject
Dim ClipT As String
Sub FormatPaste()
wdFind.Replacement.Text = ""
wdFind.Forward = True
wdFind.Wrap = wdFindContinue
wdFind.Execute
If IsEmpty(Selection.Text) And Len(Selection.Text) = 0 Then
ClipEmpty.PutInClipboard
appWd.Selection.Paste
End
Else
appWd.Selection.Paste
End If
CutCopyMode = False
End Sub
Sub NoFormatPaste()
wdFind.Replacement.Text = ""
wdFind.Forward = True
wdFind.Wrap = wdFindContinue
wdFind.Execute
If IsEmpty(Selection.Text) And Len(Selection.Text) = 0 Then
ClipEmpty.PutInClipboard
appWd.Selection.PasteSpecial DataType:=wdPasteText
End
Else
appWd.Selection.PasteSpecial DataType:=wdPasteText
End If
CutCopyMode = False
End Sub
Sub CopyDatatoWord()
Dim docWD As Word.Document
Dim sheet1 As Object
Dim sheet2 As Object
Dim SaveCell1 As String
Dim SaveCell2 As String
Dim SaveCell3 As String
Dim Dir1 As String
Dim Dir2 As String
Set appWd = CreateObject("Word.Application")
appWd.Visible = True
'Set docWD = appWD.Documents.Open("S:\Practice Quarterly Reports11 Q1 - V5\Practice Profile Template 2011.docx")
Set docWD = appWd.Documents.Open("C:\Documents and Settings\jhill\Desktop\Practice Profile Template 2011.docx")
'Select Sheet where copying from in excel
Set sheet1 = Sheets("TABLES")
Set sheet2 = Sheets("REPORT INFO")
Set wdFind = appWd.Selection.Find
ClipT = " "
ClipEmpty.SetText ClipT
sheet1.Range("B3:B6").Copy
wdFind.Text = "Qwerty01"
Call FormatPaste
sheet1.Range("B10:B15").Copy
wdFind.Text = "Qwerty02"
Call FormatPaste
sheet1.Range("C21:D28").Copy
wdFind.Text = "Qwerty03"
Call FormatPaste
sheet1.Range("B32:F42").Copy
wdFind.Text = "Qwerty04"
Call FormatPaste
sheet1.Range("B46:D52").Copy
wdFind.Text = "Qwerty05"
Call FormatPaste
sheet1.Range("B58:F68").Copy
wdFind.Text = "Qwerty06"
Call FormatPaste
sheet1.Range("B74:G84").Copy
wdFind.Text = "Qwerty07"
Call FormatPaste
sheet1.Range("B87").Copy
wdFind.Text = "Qwerty08"
Call NoFormatPaste
sheet1.Range("B88").Copy
wdFind.Text = "Qwerty09"
Call NoFormatPaste
sheet1.Range("B89").Copy
wdFind.Text = "Qwerty10"
Call NoFormatPaste
sheet1.Range("B90").Copy
wdFind.Text = "Qwerty11"
Call NoFormatPaste
sheet1.Range("B91").Copy
wdFind.Text = "Qwerty12"
Call NoFormatPaste
sheet1.Range("B92").Copy
wdFind.Text = "Qwerty13"
Call NoFormatPaste
sheet1.Range("B93").Copy
wdFind.Text = "Qwerty14"
Call NoFormatPaste
sheet1.Range("B94").Copy
wdFind.Text = "Qwerty15"
Call NoFormatPaste
sheet2.Range("D4").Copy
wdFind.Text = "Qwerty16"
Call NoFormatPaste
sheet2.Range("B5").Copy
wdFind.Text = "Qwerty17"
Call NoFormatPaste
sheet2.Range("D4").Copy
wdFind.Text = "Qwerty18"
Call NoFormatPaste
sheet2.Range("B8").Copy
wdFind.Text = "Qwerty19"
Call NoFormatPaste
sheet2.Range("B9").Copy
wdFind.Text = "Qwerty20"
Call NoFormatPaste
sheet2.Range("B10").Copy
wdFind.Text = "Qwerty21"
Call NoFormatPaste
sheet2.Range("B11").Copy
wdFind.Text = "Qwerty22"
Call NoFormatPaste
sheet2.Range("B12").Copy
wdFind.Text = "Qwerty23"
Call NoFormatPaste
sheet2.Range("B13").Copy
wdFind.Text = "Qwerty24"
Call NoFormatPaste
sheet2.Range("B14").Copy
wdFind.Text = "Qwerty25"
Call NoFormatPaste
sheet2.Range("B15").Copy
wdFind.Text = "Qwerty26"
Call NoFormatPaste
sheet2.Range("B16").Copy
wdFind.Text = "Qwerty27"
Call NoFormatPaste
sheet2.Range("B17").Copy
wdFind.Text = "Qwerty28"
Call NoFormatPaste
sheet2.Range("B5").Copy
wdFind.Text = "Qwerty29"
Call NoFormatPaste
sheet2.Range("B5").Copy
wdFind.Text = "Qwerty30"
Call NoFormatPaste
sheet2.Range("B5").Copy
wdFind.Text = "Qwerty31"
Call NoFormatPaste
SaveCell1 = sheet2.Range("D3").Text
SaveCell2 = sheet2.Range("B6").Text
SaveCell3 = SaveCell2 & "\" & SaveCell1
Dir1 = "\annapurna\Shared\Practice Quarterly Reports11 Q1 - V5\ & SaveCell2"
Dir2 = "\annapurna\Shared\Practice Quarterly Reports11 Q1 - V5\ & SaveCell3"
If Len(Dir1) = False Then
MkDir Dir1
End If
'docWD.SaveAs (Dir2 & ".docx")
docWD.SaveAs ("\annapurna\Shared\Practice Quarterly Reports\Q1_2011\Test.docx")
'appWD.Quit
Set appWd = Nothing
Set docWD = Nothing
Set appXL = Nothing
Set wbXL = Nothing
End Sub
what am i doing wrong? what is the reason i get an error only on the paste of a blank
我究竟做错了什么？我只在粘贴空白时出现错误的原因是什么
采纳答案by jordanhill123
Here is the code solution:
下面是代码解决方案：
You had to reference the countclipboardformats function to check if there was anything on the clipboard and then if empty set to a string value chosen.
您必须引用 countclipboardformats 函数来检查剪贴板上是否有任何内容，然后将空设置为所选的字符串值。
It appears to be a glitch MS clipboard copy and paste function and the clipboard function.
它似乎是一个故障 MS 剪贴板复制和粘贴功能和剪贴板功能。
Public Declare Function CountClipboardFormats Lib "user32" () As Long
Dim appWd As Word.Application
Dim wdFind As Object
Dim ClipEmpty As New MSForms.DataObject
Dim ClipT As String
Function IsClipboardEmpty() As Boolean
IsClipboardEmpty = (CountClipboardFormats() = 0)
End Function
Sub CheckClipBrd()
If IsClipboardEmpty() = True Then
ClipEmpty.PutInClipboard
End If
End Sub
Sub FormatPaste()
wdFind.Replacement.Text = ""
wdFind.Forward = True
wdFind.Wrap = wdFindContinue
wdFind.Execute
Call CheckClipBrd
appWd.Selection.Paste
CutCopyMode = False
End Sub
Sub NoFormatPaste()
wdFind.Replacement.Text = ""
wdFind.Forward = True
wdFind.Wrap = wdFindContinue
wdFind.Execute
Call CheckClipBrd
appWd.Selection.PasteSpecial DataType:=wdPasteText
CutCopyMode = False
End Sub
Sub CopyDatatoWord()
Dim docWD As Word.Document
Dim sheet1 As Object
Dim sheet2 As Object
Dim saveCell1 As String
Dim saveCell2 As String
Dim saveCell3 As String
Dim dir1 As String
Dim dir2 As String
Set appWd = CreateObject("Word.Application")
appWd.Visible = True
Set docWD = appWd.Documents.Open("\annapurna\Shared\Practice Quarterly Reports\Q1_2011\Practice Profile Template 2011.docx")
'Select Sheet where copying from in excel
Set sheet1 = Sheets("TABLES")
Set sheet2 = Sheets("REPORT INFO")
Set wdFind = appWd.Selection.Find
ClipT = " "
ClipEmpty.SetText ClipT
sheet1.Range("B3:B6").Copy
wdFind.Text = "Qwerty01"
Call FormatPaste
sheet1.Range("B10:B15").Copy
wdFind.Text = "Qwerty02"
Call FormatPaste
sheet1.Range("C21:D28").Copy
wdFind.Text = "Qwerty03"
Call FormatPaste
sheet1.Range("B32:F42").Copy
wdFind.Text = "Qwerty04"
Call FormatPaste
sheet1.Range("B46:D52").Copy
wdFind.Text = "Qwerty05"
Call FormatPaste
sheet1.Range("B58:F68").Copy
wdFind.Text = "Qwerty06"
Call FormatPaste
sheet1.Range("B74:G84").Copy
wdFind.Text = "Qwerty07"
Call FormatPaste
sheet1.Range("B87").Copy
wdFind.Text = "Qwerty08"
Call NoFormatPaste
sheet1.Range("B88").Copy
wdFind.Text = "Qwerty09"
Call NoFormatPaste
sheet1.Range("B89").Copy
wdFind.Text = "Qwerty10"
Call NoFormatPaste
sheet1.Range("B90").Copy
wdFind.Text = "Qwerty11"
Call NoFormatPaste
sheet1.Range("B91").Copy
wdFind.Text = "Qwerty12"
Call NoFormatPaste
sheet1.Range("B92").Copy
wdFind.Text = "Qwerty13"
Call NoFormatPaste
sheet1.Range("B93").Copy
wdFind.Text = "Qwerty14"
Call NoFormatPaste
sheet1.Range("B94").Copy
wdFind.Text = "Qwerty15"
Call NoFormatPaste
sheet2.Range("D4").Copy
wdFind.Text = "Qwerty16"
Call NoFormatPaste
sheet2.Range("B5").Copy
wdFind.Text = "Qwerty17"
Call NoFormatPaste
sheet2.Range("D4").Copy
wdFind.Text = "Qwerty18"
Call NoFormatPaste
sheet2.Range("B8").Copy
wdFind.Text = "Qwerty19"
Call NoFormatPaste
sheet2.Range("B9").Copy
wdFind.Text = "Qwerty20"
Call NoFormatPaste
sheet2.Range("B10").Copy
wdFind.Text = "Qwerty21"
Call NoFormatPaste
sheet2.Range("B11").Copy
wdFind.Text = "Qwerty22"
Call NoFormatPaste
sheet2.Range("B12").Copy
wdFind.Text = "Qwerty23"
Call NoFormatPaste
sheet2.Range("B13").Copy
wdFind.Text = "Qwerty24"
Call NoFormatPaste
sheet2.Range("B14").Copy
wdFind.Text = "Qwerty25"
Call NoFormatPaste
sheet2.Range("B15").Copy
wdFind.Text = "Qwerty26"
Call NoFormatPaste
sheet2.Range("B16").Copy
wdFind.Text = "Qwerty27"
Call NoFormatPaste
sheet2.Range("B17").Copy
wdFind.Text = "Qwerty28"
Call NoFormatPaste
sheet2.Range("C3").Copy
wdFind.Text = "Qwerty29"
Call FormatPaste
sheet2.Range("C3").Copy
wdFind.Text = "Qwerty30"
Call FormatPaste
sheet2.Range("C3").Copy
wdFind.Text = "Qwerty31"
Call FormatPaste
saveCell1 = sheet2.Range("D3").Text
saveCell2 = sheet2.Range("B6").Text
saveCell3 = saveCell2 & "\" & saveCell1
dir1 = "\annapurna\Shared\Practice Quarterly Reports\Q1_2011\" & saveCell2
dir2 = "\annapurna\Shared\Practice Quarterly Reports\Q1_2011\" & saveCell3
If Len(dir1) = False Then
MkDir dir1
End If
'docWD.SaveAs (Dir2 & ".docx")
docWD.SaveAs ("\annapurna\Shared\Practice Quarterly Reports\Q1_2011\Test.docx")
'appWD.Quit
Set appWd = Nothing
Set docWD = Nothing
Set appXL = Nothing
Set wbXL = Nothing
End Sub
;) Hope this helps!
;） 希望这可以帮助！
回答by Kevin MacKay
I searched all over the web trying to get my VBA copy-paste images from Excel to go to a specific point in a word doc. Found all kinds of references to bookmarks etc, but this out-of-contect one-line snippet below is a clue to the fastest way to do it.
我在整个网络上搜索，试图从 Excel 中获取我的 VBA 复制粘贴图像以转到 word 文档中的特定点。找到了对书签等的各种引用，但下面这个不相关的单行代码段是最快方法的线索。
wrdDoc.Range(Start:=wrdDoc.Paragraphs(p).Range.Start, End:=wrdDoc.Paragraphs(p).Range.End).PasteSpecial Placement:=wdInLine
