Macro copia e incolla in un altro file .docm

[kiuba]

Buonasera,
cerco aiuto per capire come fare a copiare una parte di un testo di un file di testo .docm e incollarlo in un altro file dello stesso tipo tramite macro.

Nel dettaglio ho un documento .docm aperto nel quale aggiungere la macro che deve fare le seguenti operazioni:
-copiare il testo dalla riga 2 alla riga 10;
-aprire un nuovo file di testo .docx;
-incollare il testo nella prima riga;
-tornare al file originale;
(in questo punto ci saranno altri comandi che modificheranno il testo originale che riesco a scrivere in autonomia)
-copiare di nuovo il testo dalla riga 2 alla riga 10;
-tornare al secondo file di testo;
-incollare il testo copiato successivamente al testo incollato precedentemente;
-salvare il secondo file in formato .xml

Spero che qualcuno possa aiutarmi.
Grazie anticipatamente,
kiuba

[Anthony47]

Comincia tu registrando una macro mentre, partendo dal file principale, fai esattamente quello che hai descritto.

Poi pubblica il codice così ottenuto e cercheremo di modificarlo perche' faccia quelle cose in modo effettivo e automatico.
Forse si potrebbe capire dal codice della macro, ma chiarisci se per "aprire un nuovo file di testo .docx" intendi "creare un nuovo documento word vuoto".

Per le istruzioni e i primi suggerimenti su come registrare una macro:
viewtopic.php?f=26&t=103893&p=622593#p622593
(e' riferito a Excel, ma le informazioni sono esportabili anche a Word)

Ti aspettiamo...

[kiuba]

Questo è quello che ottengo registrando la macro.

Codice: Seleziona tutto

Sub CopiaIncolla()
'
' CopiaIncolla Macro
'
'
    Selection.Copy
    Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
    Windows("etichetta.docm").Activate
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    Selection.Copy
    Windows("Documento1").Activate
    Selection.TypeParagraph
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    ChangeFileOpenDirectory _
        "C:\Users\shc-user\Desktop\nutrizione\Etichette\"
    ActiveDocument.SaveAs2 FileName:="Cognome.docx", FileFormat:= _
        wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
        :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
        :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False, CompatibilityMode:=15
    Windows("etichetta.docm").Activate
End Sub


Purtroppo selezionando a mano il testo da copiare non rimane alcun riferimento nella registrazione della macro, mi dice solo "Selection.PastAndFormat", mentre vorrei dirgli di copiare il testo da riga 2 a riga 10.

Il file da aprire potrebbe essere un file vuoto, oppure un file preparato appositamente, non mi cambia molto. Cerco la soluzione più semplice.
Grazie ancora

[Anthony47]

Dal codice non mi e' chiaro quanti file sono coinvolti, ne' quale e' il file che deve essere chiuso e quale rimanere aperto.

Questa macro, partendo dal file attivo:
-copia le righe da 2 a 10
-crea un nuovo file vuoto
-vi incolla il copiato dal file precedente
-torna al file di partenza
-TUE ISTRUZIONI manipolano il file di partenza
-si possono ripetere le istruzioni di seleziona e copia
-accoda queste nuove righe al file creato
-salva e chiude il file creato
-torna al file di partenza
Il codice:

Codice: Seleziona tutto

Sub MacroKiuba()
Dim Doc1 As Document, DocOut As Document
Dim NomeF As String, PathF As String, NomeFull As String
'
    Set Doc1 = ActiveDocument
    Selection.HomeKey Unit:=wdStory, Extend:=wdMove                 'Vai a Inizio
    Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdMove       'Vai a riga 2
    Selection.MoveDown Unit:=wdLine, Count:=9, Extend:=wdExtend     'Seleziona 9 righe
    Selection.Copy
    Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
    Set DocOut = ActiveDocument
    DocOut.Activate
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
Stop                                '<<< Solo per test, poi togliere
'
'INIZIO SECONDA FASE:
    Doc1.Activate                                                   'Torna al doc principale
'
'Inserisci QUI altri tuoi comandi
'
'Qui devi ripetere le istruzioni Seleziona e Copia
'
    DocOut.Activate                                                 'Vai al doc creato
    Selection.EndKey Unit:=wdStory, Extend:=wdMove                  'Vai al fondo
    Selection.PasteAndFormat (wdFormatOriginalFormatting)           'Incolla il copiato
'SALVATAGGIO FILE CREATO:
    With ActiveDocument
'        .XMLSaveDataOnly = False
        .XMLUseXSLTWhenSaving = False
        .XMLSaveThroughXSLT = ""
'        .XMLHideNamespaces = False
        .XMLShowAdvancedErrors = False
        .XMLSchemaReferences.HideValidationErrors = False
        .XMLSchemaReferences.IgnoreMixedContent = False
        .XMLSchemaReferences.ShowPlaceholderText = False
    End With
    NomeF = "Pippo"                         '<<<
    PathF = "C:\Users\Utente1\OneDrive\"    '<<<
    NomeFull = PathF & NomeF
    ActiveDocument.SaveAs2 FileName:=NomeFull, FileFormat:=wdFormatXML, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False, CompatibilityMode:=0
    ActiveDocument.Close
    Doc1.Activate
    Selection.HomeKey Unit:=wdStory
End Sub


Il codice va inserito in un modulo standard del tuo file word principale (immagino); le istruzioni marcate <<< vanno adattate al tuo caso; l'istruzione Stop e' inserita solo per il debug, ovviamente va tolta quando il codice e' completo
Ricchi commenti aiutano a seguire il flusso

Fai sapere...

[kiuba]

Ottimo, non ho ancora avuto il tempo di provarlo, ma il codice mi è chiaro.
Proverò ad aggiungere un ciclo for collegando il contatore ad una cella di un terzo foglio (excel) in modo da far ripetere la procedura di copia/incolla un numero variabile di volte. Dovrei riuscire a gestire il tutto.

Ti faccio sapere presto, grazie

[kiuba]

Programma funzionante!

Codice: Seleziona tutto

Sub Etichette_aggregate()

Dim I As Long, L As Long
Dim WXL As Object, WWb As Object
Dim Doc1 As Document, DocOut As Document

Set WXL = CreateObject("Excel.Application")                    'Crea una sessione nascosta di XL
Set WWb = WXL.Workbooks.Open("C:\Eti\ta.xlsm")      'Apre il file e
StartPath = "C:\Eti\xml\"
Set Doc1 = ActiveDocument
    Selection.HomeKey Unit:=wdStory, Extend:=wdMove                 'Vai a Inizio
    Selection.MoveDown Unit:=wdLine, Count:=22, Extend:=wdExtend     'Seleziona 22 righe
    Selection.Copy
    Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
    Set DocOut = ActiveDocument
    DocOut.Activate
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
'
'INIZIO SECONDA FASE:
   
    For I = 2 To WWb.Sheets("Ta").Cells(60000, "P").End(-4162).Row - 1   'cella contenente dati fino all'ultima riga da stampare
        Doc1.Activate
       
        ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord 'passo alla lettera successiva
        Selection.HomeKey Unit:=wdStory, Extend:=wdMove                 'Vai a Inizio
        Selection.MoveDown Unit:=wdLine, Count:=3, Extend:=wdMove       'Vai a riga 4
        Selection.MoveDown Unit:=wdLine, Count:=19, Extend:=wdExtend     'Seleziona 19 righe
        Selection.Copy
        DocOut.Activate
        Selection.EndKey Unit:=wdStory, Extend:=wdMove                  'Vai al fondo
        Selection.PasteAndFormat (wdFormatOriginalFormatting)           'Incolla il copiato
    Next I

Doc1.Activate
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord 'passo alla lettera successiva
Selection.HomeKey Unit:=wdStory, Extend:=wdMove                 'Vai a Inizio
Selection.MoveDown Unit:=wdLine, Count:=22, Extend:=wdMove       'Vai a riga 23
Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend     'Seleziona 1 riga
Selection.Copy
DocOut.Activate
Selection.EndKey Unit:=wdStory, Extend:=wdMove                  'Vai al fondo
Selection.PasteAndFormat (wdFormatOriginalFormatting)           'Incolla il copiato
'Stop
'SALVATAGGIO FILE CREATO:
ChangeFileOpenDirectory "C:\Eti\xml\"
 ActiveDocument.SaveAs2 FileName:="Eti.txt", FileFormat:= _
            wdFormatText, LockComments:=False, Password:="", AddToRecentFiles:=True, _
            WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
             SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
            False, Encoding:=1252, InsertLineBreaks:=False, AllowSubstitutions:=False _
            , LineEnding:=wdCRLF, CompatibilityMode:=0
            ActiveDocument.Close
Name StartPath & "Eti.txt" As StartPath & "Eti.xml"
   
   
    Doc1.Activate
    Selection.HomeKey Unit:=wdStory

WWb.Close False              'Chiudi il file senza salvare
WXL.Quit                     'Chiudi la sessione Excel
Set WXL = Nothing           
Set WWb = Nothing           
   
   
End Sub

Il programma ora parte da un file .docm già aperto e collegato con stampa unione al file ta.xlsm.
Copia le prime 22 righe e le incolla in un nuovo file di testo, poi passa tutte le lettere copiando e incollando da riga 4 a riga 22, infine copia e incolla l'ultima riga del file di testo e salva il file prima in txt e poi in xlm.

Grazie1000!!!

[kiuba]

Ancora una cosa. Vorrei aggiungere una riga in fondo al programma che riporti il file Doc1 alla prima lettera della stampa unione, ma non riesco a trovare il comando corretto.

Grazie,
kiuba

[Anthony47]

Non capisco cosa significhi "il file Doc1 alla prima lettera della stampa unione", dovresti aiutarci...

[kiuba]

Potevo evitare di farti perdere tempo, ho risolto registrando la macro..

Il comando che cercavo è il seguente:

Codice: Seleziona tutto

ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord

[Anthony47]

W il registratore di macro, santo subito

[kiuba]

W il registratore di macro, santo subito

Grazie ancora!
Kiuba