从excel粘贴到word文档中

2 回答

• 2

  这是代码解决方案：

  您必须引用countclipboardformats函数来检查剪贴板上是否有任何内容，然后将empty设置为选择的字符串值 .

  它似乎是一个小故障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
  

  ;） 希望这可以帮助！

  回复于 2024-05-04T07:44:42+08:00
• 5

  我在网上搜索试图从Excel中获取我的VBA复制粘贴图像以转到word doc中的特定点 . 找到了对书签等的各种引用，但下面这个不相关的单行代码片段是最快速的方法 .

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

  回复于 2024-05-04T07:44:42+08:00