我有一个包含学生论文分数的 excel 文档。
有一个摘要选项卡,可将分数整理成对学生更有用的格式。
我拼凑了一些 VBA 代码,这些代码打开一个 word 文档,然后逐步浏览每个学生的记录,复制输出页面并将其放到 word 文档中。
代码运行并执行它应该做的事情,除了中途失败,每次都在不同的时间点。
我试过 paste 和 pastespecial,都以同样的方式失败,这是调试器指示问题的地方。
错误代码通常是 4605,虽然我有 4198 和运行时错误 -2147023170
希望有大神能帮帮忙!
下面的代码
Sub Trilogy_output()
Dim x As Integer
Dim wdApp As Word.Application
' openword fdoc
Set wdApp = New Word.Application
With wdApp
.Visible = True
.Activate
.Documents.Add
End With
' Select main data sheet
Sheets("Physics").Select
Range("A12").Select
' Set numrows = number of rows of data.
NumRows = Range("A12", Range("A12").End(xlDown)).Rows.Count
' Select starting cell.
Range("A12").Select
' Establish "For" loop to loop "numrows" number of times.
For x = 1 To NumRows
' paste name to output sheet
Selection.Copy
Sheets("Trilogy Output").Select
Range("B2").Select
ActiveSheet.Paste
' copy sheet to word
Range("A1:G40").Select
Selection.Copy
With wdApp.Selection
' .Paste
.PasteSpecial DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine
.InsertBreak Type:=7
End With
Application.CutCopyMode = False
' Selects cell down 1 row from active cell.
Sheets("Physics").Select
ActiveCell.Offset(1, 0).Select
Next
Application.ScreenUpdating = True
End Sub
最佳答案
为了提高代码的可靠性,最好不要使用Select
和 Selection
只要有可能。依托Selection
始终指向正确的对象或范围是困惑且难以跟踪的。它也容易出错,因为某些东西可能会在执行过程中被用户或方法无意中选择。
举例说明如何删除 .Select
和 .Selection
请参阅您的程序的以下编辑版本。
Sub Trilogy_output()
Application.ScreenUpdating = False
' openword fdoc
Dim wdApp As New Word.Application
With wdApp
.Visible = True
.Activate
.Documents.Add
End With
' main data sheet
Dim Phys As Worksheet
Set Phys = ThisWorkbook.Sheets("Physics")
Dim Tri As Worksheet
Set Tri = ThisWorkbook.Sheets("Trilogy Output")
Dim CurrentCell As Range
Set CurrentCell = Phys.Range("A12") 'Starting Cell
' Set numrows = number of rows of data.
Dim NumRows As Long
NumRows = CurrentCell.End(xlDown).Row - CurrentCell.Row + 1
' Establish loop through column "A" of Phys from row 12 to end.
Dim x As Long
For x = 1 To NumRows
' paste name to output sheet
CurrentCell.Copy Destination:=Tri.Range("B2")
Tri.Range("A1:G40").Copy
DoEvents
With wdApp.Selection
' copy sheet to document
.PasteSpecial DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine
.InsertBreak Type:=7
End With
Application.CutCopyMode = False
'Move the current cell down by 1
Set CurrentCell = CurrentCell.Cells(2)
Next
Application.ScreenUpdating = True
End Sub
变更说明:Phys
和 Tri
,创建以保存对“物理”和“三部曲输出”表的引用。这可以让我们在不选择它们的情况下从这些工作表中获取范围。 CurrentCell
, 创建用于跟踪正在复制的“物理”表中的范围。声明范围允许我们最小化写入常量“A12”的次数。如果以后需要编辑,这可以简化事情。 NumRows
和 x
已从整数更改为长整数,因为 Excel 行号有可能导致整数溢出错误。 Destination
Range.Copy
的论点允许我们在同一个 Excel 应用程序中的工作表之间复制时跳过使用剪贴板。这比使用剪贴板快得多,而且更可靠,因为我们消除了对 Selection
的依赖。 . DoEvents
在 .Copy
之后添加. @TimothyRylatt 提到这可以帮助解决剪贴板需要时间来完成处理的问题。 .Cells(2)
与 .Offset(1,0)
相同将单元格向下移动 1。但我遇到了 Offset
的问题并且尽可能避免使用它。 关于excel - 从 excel 复制到 word doc : error 4605 时 VBA 代码崩溃,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/70008192/