Ir para conteúdo
Fórum Script Brasil

Sabrina Beppler

Membros
  • Total de itens

    1
  • Registro em

  • Última visita

Posts postados por Sabrina Beppler

  1. O código não está rodando, tem um erro de sintaxe na parte que selecionei vermelha e diz também que o Sub não está presente. A ideia é pegar nomes em uma planilha e salvar arquivos de mala direta separadamente, com os nomes selecionados.

     

    Sub BreakOnSection()
    Dim Arquivo As Integer
    Dim CaminhoArquivo As String
    Dim TextoProximaLinha As String

    'Set reading the file that contains the names of files that will be generated.
    Arquivo = FreeFile
    CaminhoArquivo = "C:\Users\Bepler\Desktop\aqui\655A7100.xlsm"

    'Open file for reading.
    Open CaminhoArquivo For Input As Arquivo

    'Used to set criteria for moving through the document by section.
    Application.Browser.Target = wdBrowseSection

    'A mail merge document ends with a section break next page.
    'Subtracting one from the section count stop error message.
    For i = 1 To ((ActiveDocument.Sections.Count) - 1)
        'Note: If a document does not end with a section break,
        'substitute the following line of code for the one above:
        'For I = 1 To ActiveDocument.Sections.Count

        'Select and copy the section text to the clipboard.
        ActiveDocument.Bookmarks("\Section").Range.Copy

        'Create a new document to paste text from clipboard.
        Documents.Add
        Selection.Paste

        
        'Deletes the last page (use only if necessary)
        DeleteLastLine

        'Removes the break that is copied at the end of the section, if any.
        Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
        Selection.Delete Unit:=wdCharacter, Count:=1
        ChangeFileOpenDirectory "\\BEPLER-PC\Users\Bepler\Desktop\aqui\Termos\Máscaras"

        'It makes the line reading
        Line Input #nomemb, TextoProximaLinha
        TextoProximaLinha = TextoProximaLinha

        'save to .docx and customize the file name to the line that was read
         ActiveDocument.saveAsFixedFormat OutputFileName:= _
        "\\BEPLER-PC\Users\Bepler\Desktop\aqui\Termos\Máscaras" & TextoProximaLinha & ".docx" _
        , saveFormat:=wdsaveFormat.docx, OpenAftersave:=False, OptimizeFor:=

        wdsaveOptimizeForPrint , Range:=wdsaveAllDocument, From:=1, To:=1, _
        Item:=wdsveDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
        CreateBookmarks:=wdsaveCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False

        'Closes the "temporary" file from Word without saving changes
        ActiveDocument.Close savechanges:=wdDoNotSaveChanges
        'Move the selection to the next section in the document.
        Application.Browser.Next
    Next i
            ActiveDocument.Close savechanges:=wdDoNotSaveChanges
    End Sub

    Sub Orientation()
        'If the page orientation is portrait in it is changed to landscape
        'This is a particular case in issuing certificates. Make sure that in your case there is a need
        If Selection.PageSetup.Orientation = wdOrientPortrait Then
            Selection.PageSetup.Orientation = wdOrientLandscape
        Else
        Selection.PageSetup.Orientation = wdOrientPortrait
        End If
    ActiveWindow.ActivePane.VerticalPercentScrolled = 0
    End Sub

    Sub DeleteLastLine()
    'This is a particular case in issuing certificates. Make sure that in your case there is a need
        Selection.HomeKey Unit:=wdStory
        Selection.EndKey Unit:=wdStory
        Selection.MoveLeft Unit:=wdCharacter, Count:=1
        Selection.Delete Unit:=wdCharacter, Count:=1
        Selection.Delete Unit:=wdCharacter, Count:=1
        Selection.Delete Unit:=wdCharacter, Count:=1
        Selection.Delete Unit:=wdCharacter, Count:=1
        Selection.Delete Unit:=wdCharacter, Count:=1
    End Sub

     

    😊 Muito obrigadinha pela atenção!

×
×
  • Criar Novo...