返回

错误 4605 试图在 Word VBA 中粘贴文本

发布时间:2022-07-24 13:51:29 448
# ios

我已经编译了一个代码:

1-清理活动文档的所有内容,包括页眉和页脚;

2-将文件夹中的几个word文件的内容依次复制到当前文件,在每个文件后插入分页符;

3-删除空白页(我想删除另一个空白页,但我不知道如何)。

这段代码确实运行了好几次,但现在,我不知道为什么,它给出了错误 4605,代码中的黄线是:Selection.PasteAndFormat wdPasteDefault。拜托,你能帮帮我吗?我的代码是:

Sub criarRelatorio()

        Application.ScreenUpdating = True

        Application.DisplayAlerts = False 'desabilita mensagens de atualização

        Dim MasterDoc As String
        Dim mySource As Object
        Dim oFile As Object
        Dim endPasta As String
        Dim SeparateDoc As String
        Dim nFile As Integer
        Dim i As Integer
        Dim Msg, Style, Title, Response, MyString

        endPasta = "H:\Assessores\Pareceres\LHR\relats"

    Msg = "Deseja colar os " & nFiles(endPasta) & " arquivos que estão na pasta (" & endPasta & ") neste documento? " _
        & vbNewLine & vbNewLine & "Isso pode demorar de 5 a 10 minutos." & vbNewLine & vbNewLine & _
    " Caso aceite, aguarde até que apareça uma mensagem confirmando a colagem dos itens."    ' Define message.
    Style = vbYesNo Or vbCritical Or vbDefaultButton2    ' Define buttons.
    Title = "Utilização de macro LHR"    ' Define title.

        ' Display message.
        Response = MsgBox(Msg, Style, Title)
    If Response = vbYes Then    ' User chose Yes.
       GoTo aceitou ' Perform some action.
        Else    ' User chose No.
      GoTo cancelou ' Perform some action.
    End If


aceitou:
    'delete all content before starting
    Selection.WholeStory
    Selection.Delete Unit:=wdCharacter, Count:=1
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    Selection.WholeStory
    Selection.Delete Unit:=wdCharacter, Count:=1
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument


        Set WordApplication = CreateObject("Word.Application")
        Set obj = CreateObject("Scripting.FileSystemObject")
        MasterDoc = ActiveDocument.Name
        Set mySource = obj.getfolder(endPasta)

    nFile = nFiles(endPasta)
    i = 0

    For Each oFile In mySource.Files
        If i < nFile Then
            Application.Documents.Open mySource & "\" & oFile.Name, Visible:=False
            Documents(oFile.Name).Activate
            SeparateDoc = ActiveDocument.Name
            Selection.WholeStory
            Selection.Expand wdParagraph
            Selection.Copy
            Documents(oFile.Name).Close
            Documents(MasterDoc).Activate
            Selection.InsertBreak Type:=wdSectionBreakNextPage
            Selection.PasteAndFormat wdPasteDefault
            Selection.Collapse Direction:=wdCollapseEnd
        End If
    i = i + 1
    Next oFile

    ActiveDocument.Paragraphs(1).Range.Delete

    'removing first line
    ActiveDocument.Range(0, 0).Select
    Selection.MoveEnd wdLine
    Selection.Delete
    ActiveDocument.Undo
    Selection.HomeKey Unit:=wdStory

    MsgBox "Os " & nFiles(endPasta) & " Relatórios já foram colados!", , "Atenção!!"
        Exit Sub
cancelou:
    MsgBox "Operação Não Executada", , "Cancelado"
        Exit Sub

    'habilita mensagens de atualização
    Application.DisplayAlerts = True
End Sub

 

特别声明:以上内容(图片及文字)均为互联网收集或者用户上传发布,本站仅提供信息存储服务!如有侵权或有涉及法律问题请联系我们。
举报
评论区(1)
按点赞数排序
用户头像
下一篇
php-Html标签不在Javascript中呈现 2022-07-24 11:52:17