Excel VBA 代码适用于我，但不适用于其他人

Question

我有一些代码可以做很多事情，并且对我来说一切正常，但对其他人却不行。对于其他人，它会打开 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

Answer 1

问题的快速解决方案在于如何将范围粘贴到 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