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 与恶龙缠斗过久,自身亦成为恶龙；凝视深渊过久,深渊将回以凝视…
