将excel粘贴到word文档中
我正在将excel中的单元格复制到打开的word文档中。我这样做只是将单元格内容复制到剪贴板中,并替换word文档中的特定关键字,如下所示: 如果cell将excel粘贴到word文档中,excel,vba,ms-word,Excel,Vba,Ms Word,我正在将excel中的单元格复制到打开的word文档中。我这样做只是将单元格内容复制到剪贴板中,并替换word文档中的特定关键字,如下所示: 如果cellA1=“some word”我也需要替换word文档中的字符串“QUERYA1” 我是这样做的: Sub NoFormatPaste() wdFind.Replacement.Text = "" wdFind.Forward = True wdFind.Wrap = wdFindContinue wdFind.
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)
当这个公式不产生任何结果或空白,并且我运行我的宏时,我在将其粘贴到word中时出错。我在此行中收到一个名为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
)()希望这有帮助 我搜索了整个网页,试图从Excel中获取VBA副本粘贴图像,以转到word文档中的特定点。找到了对书签等的各种引用,但下面这段断章取义的一行代码提示了最快的方法
wrdDoc.Range(Start:=wrdDoc.Paragraphs(p).Range.Start, End:=wrdDoc.Paragraphs(p).Range.End).PasteSpecial Placement:=wdInLine