VBA循环未以一致的方式向word发送数据

我有下面的代码，现在通过一个简单的电子表格粘贴组织， 一个表格将单个单元格值和图表转换为word模板。代码运行并正确生成word和pdf版本。但我看到的是，表格有时会在组织应该在的地方结束，并且图表会在文件中重复。循环的每个输出似乎都有所不同，我无法确定信息是否在粘贴之前没有从剪贴板中清除。我需要把这些部分分成子部分还是什么

谢谢你的帮助

    Sub CreateBasicWordReport()
   Dim WdApp As Word.Application
   Dim wdDoc As Word.Document
   Dim SaveName As String
   Dim FileExt As String
   Dim LstObj1 As ListObject
   Dim MaxValue As Integer
   Dim FilterValue As Integer
   Dim Organisation As String
   Dim Rng As Range
   Dim WS As Worksheet
   
   Set LstObj1 = Worksheets("Sheet1").ListObjects("Table1")
   
   MaxValue = WorksheetFunction.Max(LstObj1.ListColumns(1).Range)
    
   FilterValue = MaxValue
    
   Set WdApp = CreateObject("Word.Application")
   Do Until FilterValue = 0
   
   Application.DisplayAlerts = False
    
      Sheets.Add(After:=Sheets("Sheet1")).Name = "Static"
      Sheets("Sheet1").Select
    
      'moved outside of loop
      ' Set WdApp = CreateObject("Word.Application")
   
      With WdApp
         .Visible = True
         .Activate
         'create new document and assign to object variable
         Set wdDoc = .Documents.Add("C:\Users\david\Documents\Custom Office Templates\Template2.dotx")
      'now mostly finished with WdApp as from here wdDoc is used
      End With
      ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:=FilterValue
      Range("F11").Select
              
      Range("A1", Range("A1").End(xlDown).End(xlToRight)).Copy
    
      '         .Selection.GoTo what:=-1, Name:="TableLocation"
      '         .Selection.Paste
      wdDoc.Bookmarks("TableLocation").Range.Paste
    
      For Each Row In Range("Table1[#All]").Rows
         If Row.EntireRow.Hidden = False Then
            If Rng Is Nothing Then Set Rng = Row
            Set Rng = Union(Row, Rng)
         End If
      Next Row
      Set WS = Sheets("Static")
      Rng.Copy Destination:=WS.Range("A1")

      '      Sheets("Static").Select
      '      Sheets("Static").Activate
      Organisation = WS.Range("D2").Value
    
      '      Sheets("Static").Select
      '      Range("D2").Copy
      WS.Range("D2").Copy
      
      '         .Selection.GoTo what:=-1, Name:="Organisation"
      '         .Selection.PasteAndFormat wdFormatPlainText
      wdDoc.Bookmarks("Organisation").Range.PasteAndFormat wdFormatPlainText
      Application.CutCopyMode = False
    
      '      Sheets("Static").Select
      '      Range("F2").Copy
      WS.Range("F2").Copy
      
    
      '         .Selection.GoTo what:=-1, Name:="MalePatients"
      '         .Selection.PasteAndFormat wdFormatPlainText
      wdDoc.Bookmarks("MalePatients").Range.PasteAndFormat wdFormatPlainText
         
      Application.CutCopyMode = False
    
      Chart2.ChartArea.Copy
    
      '         .Selection.GoTo what:=-1, Name:="ChartLocation"
      '         .Selection.Paste
      wdDoc.Bookmarks("ChartLocation").Range.Paste
    
      If WdApp.Version <= 11 Then
         FileExt = ".doc"
      Else
         FileExt = ".docx"
      End If
    
      SaveName = Environ("UserProfile") & "\Desktop\Report for " & _
         Organisation & " " & _
         Format(Now, "yyyy-mm-dd hh-mm-ss") & FileExt
        
      If WdApp.Version <= 12 Then
         ' .ActiveDocument.SaveAs SaveName
         wdDoc.SaveAs SaveName
      Else
         ' .ActiveDocument.SaveAs2 SaveName
         wdDoc.SaveAs2 SaveName
      End If
    
      SaveNamePDF = Environ("UserProfile") & "\Desktop\Report " & _
         Organisation & " " & _
         Format(Now, "yyyy-mm-dd hh-mm-ss") & ".pdf"

      wdDoc.ExportAsFixedFormat _
         OutputFileName:=SaveNamePDF, _
         ExportFormat:=wdExportFormatPDF _
    
         wdDoc.Close
    
         FilterValue = FilterValue - 1
         Sheets("Static").Delete
         
   Application.DisplayAlerts = True
      
   Loop

   WdApp.Quit
    
   Set WdApp = Nothing
    
End Sub

---

您可能想也可能不想将此作为问题的答案，但以下是一些可以改进代码的方法，以便更好地控制代码的运行方式。它不是一个完整的、正确工作的代码模块意义上的解决方案，但如果您采纳此建议，它将使您能够自己解决这个问题以及将来可能遇到的许多其他问题

1避免使用复制和粘贴。正如您正确地注意到的那样，这些将您置于Windows剪贴板的支配之下。相反，将源对象或值指定给变量，然后在目标处插入变量的内容。例如：

Organisation = WS.Range("D2").Value
wdDoc.Bookmarks("Organisation").Range.Text = Organisation

现在，您可以控制在目标点插入的内容。除其他事项外，您可以在每个循环结束时重置变量，这样就不会有重复插入对象或值的风险，这些对象或值可能会从一个循环转到下一个循环

2与…一起使用。。。以结束以显式指定对象的父对象。这样，您就不会冒意外引用与预期不同的对象的风险。例如，在这段代码摘录中

With WdApp
    Set wdDoc = .Documents.Add("C:\Users\david\Documents\Custom Office Templates\Template2.dotx")
End With

Range("A1", Range("A1").End(xlDown).End(xlToRight)).Copy

。。。最后一行中复制的范围可能不是您期望的范围。如果当前的活动对象是新创建的Word文档，则范围对象可能会被解释为文档中的某个范围，而不是要复制的电子表格范围

要保持控制，请始终使用以下选项：

With WdApp
    Set wdDoc = .Documents.Add("C:\Users\david\Documents\Custom Office Templates\Template2.dotx")
End With

With MyWorkbook.Sheets("MySheet")
    Set MyTableRange = .Range("A1", .Range("A1").End(xlDown).End(xlToRight))
End With

---

这只是几个要点，但这些是您应该采用的基本良好编码实践。我认为它们将帮助您解决代码中的问题。

您看到的问题可能是由使用剪贴板引起的。复制和粘贴较大的项目（例如数据表、图表）时可能会有延迟

当您使用剪贴板时，您正在将一些控制权传递给操作系统。VBA包含一个将控制权传递给操作系统的函数DoEvents。然后，在操作系统处理完其队列中的事件后，返回控件。通过在每次复制/粘贴后添加此项，应该可以让事情迎头赶上

通过直接设置“组织”和“男性患者”的值，您还可以稍微减少剪贴板的使用

Sub CreateBasicWordReport()
   Dim WdApp As Word.Application
   Dim wdDoc As Word.Document
   Dim SaveName As String
   Dim FileExt As String
   Dim LstObj1 As ListObject
   Dim MaxValue As Integer
   Dim FilterValue As Integer
   Dim Organisation As String
   Dim Rng As Range
   Dim WS As Worksheet
   
   Application.DisplayAlerts = False
   Set LstObj1 = Worksheets("Sheet1").ListObjects("Table1")
   
   MaxValue = WorksheetFunction.Max(LstObj1.ListColumns(1).Range)
    
   FilterValue = MaxValue
    
   Set WdApp = CreateObject("Word.Application")
   Do Until FilterValue = 0
    
      Sheets.Add(After:=Sheets("Sheet1")).Name = "Static"
      Sheets("Sheet1").Select
   
      With WdApp
         .Visible = True
         .Activate
         'create new document and assign to object variable
         Set wdDoc = .Documents.Add("C:\Users\david\Documents\Custom Office Templates\IBD Registry Quarterly Report Template2.dotx")
         'now mostly finished with WdApp as from here wdDoc is used
      End With
      
      ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:=FilterValue
      Range("F11").Select
              
      Range("A1", Range("A1").End(xlDown).End(xlToRight)).Copy
    
      wdDoc.Bookmarks("TableLocation").Range.Paste
      DoEvents
      
      For Each Row In Range("Table1[#All]").Rows
         If Row.EntireRow.Hidden = False Then
            If Rng Is Nothing Then Set Rng = Row
            Set Rng = Union(Row, Rng)
         End If
      Next Row
      Set WS = Sheets("Static")
      Rng.Copy Destination:=WS.Range("A1")
      Application.CutCopyMode = False
      DoEvents

      Organisation = WS.Range("D2").Value
      wdDoc.Bookmarks("Organisation").Range.Text = Organisation
    
      wdDoc.Bookmarks("MalePatients").Range.Text = WS.Range("F2").Text
    
      Chart2.ChartArea.Copy
      wdDoc.Bookmarks("ChartLocation").Range.Paste
      DoEvents
      Application.CutCopyMode = False
    
      If CLng(WdApp.Version) <= 11 Then
         FileExt = ".doc"
      Else
         FileExt = ".docx"
      End If
    
      SaveName = Environ("UserProfile") & "\Desktop\IBD Registry Quarterly Report for " & _
         Organisation & " " & _
         Format(Now, "yyyy-mm-dd hh-mm-ss")
      SaveNamePDF = SaveName & ".pdf"
      SaveName = SaveName & FileExt
      
      If CLng(WdApp.Version) <= 12 Then
         wdDoc.SaveAs SaveName
      Else
         wdDoc.SaveAs2 SaveName
      End If
    
      wdDoc.ExportAsFixedFormat _
         OutputFileName:=SaveNamePDF, _
         ExportFormat:=wdExportFormatPDF _

         wdDoc.Close

         FilterValue = FilterValue - 1
         
         Sheets("Static").Delete
         
         Application.DisplayAlerts = True
      
   Loop

   WdApp.Quit
    
   Set WdApp = Nothing
    
End Sub

---

你的第二点不正确。由于代码位于Excel范围内，因此将始终被解释为Excel范围。唯一出现混淆的情况是，如果您将变量声明为Range，而不是Dim WdRange作为Word.Range。。。比如在OP的问题中这里的声明Dim Rng as Range。您的评论可以归结为这样一个想法：只要变量声明是固定的，OP就可以继续依赖隐式引用。在我看来，这是一个非常无用的建议，不是对我，而是对发布这个问题的新程序员。每个人都依赖于代码中的隐式引用，即使是你。每次将变量声明为String或Long，或使用Left、Split或Trim等函数时，都依赖于对VBA库的隐式引用。甚至您的代码示例也包含两个隐式引用。为避免出现这种情况，xlDown和xlToRight必须写成Excel.xlDown和Excel.xlToRight。您在第二点中的错误之处在于，RangeA1、RangeA1.EndxlDown.EndxlToRight.Copy可能被解释为属于Word。那不可能发生。但是，如果工作簿中的其他工作表被激活，则可能会从错误的工作表中获取范围。我同意，对所引用的工作簿/工作表进行详细说明是一种良好的做法。你只是用错误的结论来说明你的观点。