从excel粘贴到word文档
我从Excel复制单元格到一个开放的文档。 我这样做的方式只是将单元格的内容复制到剪贴板中，并在word文档中replace特定的KEYWORD，如下所示：
如果单元格A1 = "some word"我也需要replace单词文档中的string“ QUERYA1 ”
我正在这样做：
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
当这个子运行时，它会在每个字段上工作，除非它在单元格为空的时候给出一个错误。 我有这个公式在单元格中： =+IF(K10="XXX","",K10)
当这个公式产生任何东西或空白，我运行我的macros，我得到一个错误，在这个贴上这个词。 我得到一个错误，称为4168 command failed/command execution在这一行：
appWd.Selection.PasteSpecial DataType:=wdPasteText
这是我的完整代码：
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 Reports\2011 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 Reports\2011 Q1 - V5\ & SaveCell2" Dir2 = "\\annapurna\Shared\Practice Quarterly Reports\2011 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
我究竟做错了什么？ 什么原因我只是在一个空白的粘贴错误
这里是代码解决scheme：
您必须引用countclipboardformats函数来检查剪贴板上是否有任何内容，然后将空值设置为所选的string值。
这似乎是一个毛刺MS剪贴板复制和粘贴function和剪贴板function。
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
;） 希望这可以帮助！
我在网上search了所有试图从Excel中获取我的VBA复制粘贴图像到文档doc中的特定点。 发现书签等的各种引用，但这个不符合以下单行代码片段是最快捷的方法线索。
wrdDoc.Range(Start:=wrdDoc.Paragraphs(p).Range.Start, End:=wrdDoc.Paragraphs(p).Range.End).PasteSpecial Placement:=wdInLine