您的位置: 首页  >  技术问答  >  从excel粘贴到word文档中

从excel粘贴到word文档中

分类: 技术问答 • 2022-09-16 17:07:30
问题描述：

我将excel中的单元格复制到打开的word文档中。我这样做的方法就是复制单元格的内容到剪贴板和单词替换文档中的一个特定的关键字，像这样：从excel粘贴到word文档中

如果电池A1 = "some word"我需要的Word文档

太替换字符串“ 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)

当这个公式产生NOTHING或空白，并且我运行我的宏，我得到一个错误在PASTING这个词。我收到这条线上的叫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

我到底做错了什么？什么是我只上的空白

答

这里贴得到一个错误的原因是代码的解决方案：

你必须引用countclipboardformats函数来检查是否有剪贴板上的任何东西，然后如果空集到选择的字符串值。

它似乎是一个毛刺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

;）希望这有助于！

+0

你是男人 – 2011-06-15 17:40:33

答

我在网上搜索了所有试图从Excel中获取我的VBA复制粘贴图像以转到单词doc中的特定点。发现书签等的各种引用，但是下面这个不合适的单行代码片段是最快捷的方式。

wrdDoc.Range(Start:=wrdDoc.Paragraphs(p).Range.Start, End:=wrdDoc.Paragraphs(p).Range.End).PasteSpecial Placement:=wdInLine

相关推荐