從excel粘貼到word文檔中

我將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

我到底做錯了什麼？什麼是我只上的空白

來源

2011-06-10 l--' ' ' ' ' ' ---------' ' ' ' ' ' ' ' ' ' ' '

這裏貼得到一個錯誤的原因是代碼的解決方案：

你必須引用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

;）希望這有助於！

來源

2011-06-10 22:56:02 jordanhill123

你是男人 – 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

來源

2012-10-04 18:47:28

從excel粘貼到word文檔中

回答

相關問題