Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
825 views
in Technique[技术] by (71.8m points)

vba - pasting from excel into a word document

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:

if cell A1 = "some word" i need too replace the string "QUERYA1" in the word document

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)

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 execution on this line:

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 Reports2011 Q1 - V5Practice Profile Template 2011.docx")
    Set docWD = appWd.Documents.Open("C:Documents and SettingsjhillDesktopPractice 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 = "\annapurnaSharedPractice Quarterly Reports2011 Q1 - V5 & SaveCell2"
    Dir2 = "\annapurnaSharedPractice Quarterly Reports2011 Q1 - V5 & SaveCell3"


    If Len(Dir1) = False Then
    MkDir Dir1
    End If


    'docWD.SaveAs (Dir2 & ".docx")
    docWD.SaveAs ("\annapurnaSharedPractice Quarterly ReportsQ1_2011Test.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

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

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.

It appears to be a glitch MS clipboard copy and paste function and the clipboard 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("\annapurnaSharedPractice Quarterly ReportsQ1_2011Practice 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 = "\annapurnaSharedPractice Quarterly ReportsQ1_2011" & saveCell2
    dir2 = "\annapurnaSharedPractice Quarterly ReportsQ1_2011" & saveCell3


    If Len(dir1) = False Then
    MkDir dir1
    End If


    'docWD.SaveAs (Dir2 & ".docx")
    docWD.SaveAs ("\annapurnaSharedPractice Quarterly ReportsQ1_2011Test.docx")

    'appWD.Quit

Set appWd = Nothing
Set docWD = Nothing
Set appXL = Nothing
Set wbXL = Nothing

End Sub

;) Hope this helps!


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...