我有一些代码可以做很多事情,并且对我来说一切正常,但对其他人却不行。对于其他人,它会打开 Word,但不会填充任何数据和错误。我对此比较陌生,所以不知道为什么这对我有用,但对其他人无效,我想了解 future 的编码。
谢谢参观。
这是在“wrdApp.Selection.Paste”行上给出错误的代码部分
Sheets("Sch1A").Range("Print_Area").Copy
With objWord
wrdApp.Selection.Paste
这不是完整的代码集,但这是包含错误和相关变量的部分。'Below is where the embedded word doc opens and pastes in the code
Dim wrdApp As Word.Application
Set wrdApp = CreateObject("Word.Application")
Dim sh As Shape
Dim objWord As Object, objNewDoc As Object ''Word.Document
'Dim objOLE As New OLEObject
Dim objOLE As OLEObject
Dim wSystem As Worksheet
Dim cell As Range
Set wSystem = Worksheets("Schedule variables")
''The shape holding the object from 'Create from file'
''Object 2 is the name of the shape
Set sh = wSystem.Shapes("PageBreak")
''The OLE Object contained
Set objOLE = sh.OLEFormat.Object
'Instead of activating in-place, open in Word
objOLE.Verb xlOpen
Set objWord = objOLE.Object 'The Word document
Dim objUndo As Object 'Word.UndoRecord
'Be able to undo all editing performed by the macro in one step
Set objUndo = objWord.Application.UndoRecord
objUndo.StartCustomRecord "Edit In Word"
Sheets("Sch1A").Range("Print_Area").Copy
With objWord
wrdApp.Selection.Paste
wrdApp.Selection.InsertBreak
End With
'Add footer
wrdApp.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
wrdApp.Selection.Font.Size = 7
wrdApp.Selection.TypeParagraph
wrdApp.Selection.TypeText ThisWorkbook.Sheets("Schedule variables").Range("S1").Text
'wrdApp.Selection.TypeText vbTab & vbTab & " " & ThisWorkbook.Sheets("Schedule variables").Range("O5").Text
wrdApp.Selection.TypeParagraph
wrdApp.Selection.Font.Size = 7
wrdApp.Selection.TypeText ThisWorkbook.Sheets("Schedule variables").Range("S2").Text
wrdApp.Selection.TypeParagraph
wrdApp.Selection.Font.Size = 7
wrdApp.Selection.TypeText ThisWorkbook.Sheets("Schedule variables").Range("S3").Text
'wrdApp.Selection.TypeParagraph
'wrdApp.Selection.TypeText vbTab & vbTab & " " & ThisWorkbook.Sheets("Schedule variables").Range("O7").Text
wrdApp.ActiveWindow.ActivePane.View.SeekView = 0
Sheets("Sch1B").Range("Print_Area").Copy
With objWord
wrdApp.Selection.Paste
wrdApp.Selection.InsertBreak
End With
Sheets("Sch2").Range("Print_Area").Copy
With objWord
wrdApp.Selection.Paste
wrdApp.Selection.InsertBreak
End With
Sheets("Sch3").Range("Print_Area").Copy
With objWord
wrdApp.Selection.Paste
wrdApp.Selection.InsertBreak
End With
'Password protect and only allow track changes in Word document
'wrdApp.ActiveDocument.Protect password:="wildcard", NoReset:=False, Type:= _
' wdAllowOnlyComments, UseIRM:=False, EnforceStyleLock:=False
'Save as client name to same path the Excel file is saved and undo everything for the embedded document to be clean
With objWord
objWord.SaveAs2 ActiveWorkbook.Path & "\" & Sheets("Schedule variables").Range("S1").Value
objUndo.EndCustomRecord
Set objUndo = Nothing
objWord.Undo
.Application.Quit False
End With
Set objWord = Nothing
Set WordDoc = Nothing
Set WordApp = Nothing
'TURN BACK ON IN FINAL CODE
'Sheets("Schedule variables").Visible = False
'Sheets("Sch1A").Visible = False
'Sheets("Sch1B").Visible = False
'Sheets("Sch2").Visible = False
'Sheets("Sch3").Visible = False
'ThisWorkbook.Protect password:="wildcard"
Application.ScreenUpdating = True
'Call EmailFile
'Show message box where schedule was saved down
MsgBox Sheets("Schedule variables").Range("S1").Text & " has been saved in this folder " & ActiveWorkbook.Path
End Sub
最佳答案
问题的快速解决方案在于如何将范围粘贴到 Word。 OLE 对象不适用于进程。
下面的示例应该为您提供一个模板以应用于您的解决方案。
Option Explicit
Sub CopyPrintAreasToWord()
Dim wordApp As Word.Application
Dim wordDoc As Word.Document
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = True
Set wordDoc = wordApp.Documents.Add
Dim ws As Worksheet
Set ws = Sheet1
Dim currentPrintArea As Range
Set currentPrintArea = ws.Range("Print_Area")
currentPrintArea.Copy
wordDoc.Paragraphs(1).Range.PasteExcelTable LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=False
End Sub
关于Excel VBA 代码适用于我,但不适用于其他人,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/68655673/