Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Copy & Paste


Betrifft: Copy & Paste von: Inshin
Geschrieben am: 22.05.2017 15:02:17

Moin,
für Eure Hilfe wäre ich dankbar…

Ich kopieren aus einer Excel Datei Textbausteine in eine Worddatei, in dem ich in Excel einen Doppelklick auf die Zelle mache und diese dann nach Word kopiert wird.

'markierte Zellen kopieren
Selection.Copy

'in Word einfügen
Word_App.Selection.PasteSpecial Link:=False, DataType:=wdPasteRTF, _
Placement:=wdInLine, DisplayAsIcon:=False

Word_App.Selection.TypeParagraph ' zeilenumbruch einfügen

Jetzt möchte ich das erweitern….
Ich möchte nun die Möglichkeit schaffen, mehrere Bausteine in Excel auszuwählen (z.B. Kreuz in der Nachbarspalte) und diese dann gesamt nach Word kopieren, jede Auswahl in eine neue Zeile in der Worddatei und mit einer Nummerierung. Das können zwische 1 und n Auswahltexte sein. Als Start der Kopiervorganges Doppelklick oder Buttom. Danach sollen alle Auswahlkreuze gelöscht werden.

Beispiel:
EXCELLISTE
Baustein 01 | x
Baustein 02
Baustein 03 | x

WORDDATEI
Ziel01 Baustein 01
Ziel02 Baustein 03

  

Betrifft: AW: Copy & Paste von: fcs
Geschrieben am: 22.05.2017 22:16:11

Moin Inshin,

damit die Formatierung für den zusätzlichen Text mit in die Worddatei übernommen wird muss man diesen schon in Excel in den Text einbauen - dies am besten in einer temporären Zusatzspalte.

In zwei For-Next-Schleifen kann man dann die Zeilenzählung ergänzen und die Zellen nach Word kopieren.

LG
Franz

Sub Makro___1()
'

    Dim Word_App As Object  'Word.Application
    Dim wks As Worksheet
    Dim Zeile As Long, Zeile_L As Long
    Dim Zaehler As Long
    
    Const Zei_1 As Long = 2 '1. Zeile mit Baustei
    Const Spa_X As Long = 2 'Spalte mit X-Einträgen
    Const Spa_T As Long = 1 'Spalte mit den Baustein Texten
    Const Spa_C As Long = 3 'temporäre Spalte für zu kopierende Texte
    
    Set wks = ActiveSheet
    
    Set Word_App = VBA.CreateObject("Word.Application")
    Word_App.Visible = True
    Word_App.Documents.Add DocumentType:=0 ' 0 = wdNewBlankDocument
    
    With wks
        Zaehler = 0
        Zeile_L = .Cells(.Rows.Count, Spa_X).End(xlUp).Row ' 2 = Nummer der Spalte mit den "X"
        'Spalte mit Textbausteinen in Zusatzspalte kopieren
        .Columns(Spa_T).Copy .Columns(Spa_C)
        'Nummerierung bei den zu kopierenden Texten einfügen
        For Zeile = Zei_1 To Zeile_L
            If UCase(.Cells(Zeile, Spa_X).Text) = "X" Then
                Zaehler = Zaehler + 1
                'markierte Zellen kopieren
                .Cells(Zeile, Spa_C).Value = "Ziel " & Format(Zaehler, "00") & " " _
                        & .Cells(Zeile, Spa_C).Text
            End If
        Next Zeile
        
        'gewählte Einträge nach Word kopieren
        For Zeile = Zei_1 To Zeile_L
            If UCase(.Cells(Zeile, Spa_X).Text) = "X" Then
                
                .Cells(Zeile, Spa_C).Copy
                'in Word einfügen

                Word_App.Selection.PasteSpecial Link:=False, DataType:=1, _
                    Placement:=0, DisplayAsIcon:=False ' 1 = wdPasteRTF  0 = wdInLine

                Word_App.Selection.TypeParagraph ' zeilenumbruch einfügen
            
            End If
        Next Zeile
        'X löschen
        .Range(.Cells(Zei_1, Spa_X), .Cells(Zeile_L, Spa_X)).ClearContents
        'Spalte mit zu kopierenden Werten wieder löschen
        .Columns(Spa_C).Delete
    End With
    Word_App.Activate
End Sub




  

Betrifft: AW: Copy & Paste von: Inshin
Geschrieben am: 23.05.2017 12:13:38

Moin Franz,
goil..funktioniert toll.

Ich habe die Daten bisher in ein schon geöffnetes Dokument kopiert mit
Set Word_App = GetObject(, "Word.Application")
Set Word_Doc = Word_App.ActiveDocument

Das habe ich noch geändert und alles funktioniert toll.
Vielen Dank für Deine Hilfe!!!


  

Betrifft: AW: Copy & Paste von: Inshin
Geschrieben am: 23.05.2017 12:36:25

MIST...kannst mir nochmals unter die Arme greifen. Ich bekomme nun Fehlermeldungen dass
kein Dokument geöffnet ist. Wie pass ich das an?

Ich habe aus
Set Word_App = VBA.CreateObject("Word.Application")
Word_App.Visible = True
Word_App.Documents.Add DocumentType:=0 ' 0 = wdNewBlankDocument

das gemmacht
Set Word_App = GetObject(, "Word.Application")
Set Word_Doc = Word_App.ActiveDocument
Word_App.Visible = True

aber das geht nicht, er findet anscheinend kein aktives Dokument.


  

Betrifft: AW: Copy & Paste von: Inshin
Geschrieben am: 23.05.2017 13:44:05

ich habe gelesen das beim Öffnen des Dokumentes es automatisch auf aktiv gesetzt wird.
Das erklärt auch warum ich eine Fehlermeldung bekomme wenn ich in eine geöffnetes Doc
kopieren möchte,

Kann man den Code so ändern das geprüft wird ob ein bestimmtes Dokument geöffnet ist?
Wenn ja -- setzte es aktiv und kopiere den Excel Inhalt und wechsele wieder zu Excel (Word nicht schließen)
Wenn nein -- öffne ein bestimmtes Dokument und kopiere den Excel Inhalt und wechsele wieder zu Excel (Word nicht schließen)


  

Betrifft: AW: Copy & Paste von: Inshin
Geschrieben am: 23.05.2017 15:42:04

habe die Frage wieder auf geöffnet gesetzt...bekomme es nicht gebacken auf ein geöffnetes Dokument zuzugreifen...unglaublich.
thx Tom


  

Betrifft: AW: Daten von Excel nach Word von: fcs
Geschrieben am: 24.05.2017 04:43:07

Hallo Tom,

ich hab das Makro angepasst, so dass die verschiedenen Varianten
- Word geöffnet/nicht geöffnet
- Word-Dokument geöffnet / nicht geöffnet

abgedeckt sind.
Das Ganze läuft über eine Fehlerbehandling mit entsprechender Aktion.

LG
Franz

Sub Bausteine_nach_Word_kopieren()
'
    Dim Word_App As Object  'Word.Application
    Dim Word_Doc As Object  'Word.Document
    Dim wks As Worksheet
    Dim Zeile As Long, Zeile_L As Long
    Dim Zaehler As Long
    Dim strPathDatei As String
    Dim strNameDatei As String
    Dim MsgTitel As String
    
    Const Zei_1 As Long = 2 '1. Zeile mit Baustei
    Const Spa_X As Long = 2 'Spalte mit X-Einträgen
    Const Spa_T As Long = 1 'Spalte mit den Baustein Texten
    Const Spa_C As Long = 3 'temporäre Spalte für zu kopierende Texte
    
    MsgTitel = "Textbausteine nach Word kopieren"
    
'Verzeichnis der Word-Datei
    strPathDatei = "C:\Users\Public\Test" & "\" ' anpassen ggf. deaktivieren/löschen!!!"
'Variante wenn Worddatei im gleichen Verzeichnis liegt wie diese Exceldatei
'    strPathDatei = ThisWorkbook.Path & "\"      'Zeile ggf. deaktivieren/löschen!!!"
    
'Name der Word-Datei
    strNameDatei = "TestWord.docx"         'anpassen!!!
    
    On Error GoTo Fehler
    
    Set wks = ActiveSheet
    
'Prüfen, ob gg. zu öffnende Datei existiert
    If Dir(strPathDatei & strNameDatei) = "" Then
        MsgBox "Word-Datei existiert nicht" & vbLf & strPathDatei & strNameDatei, _
            vbInformation + vbOKOnly, "Fehler - " & MsgTitel
        Exit Sub
    End If

'Prüfen, ob Bausteine markiert sind
    With wks
        'letzte Zeilemit Daten in Spalte mit "x"
        Zeile_L = .Cells(.Rows.Count, Spa_X).End(xlUp).Row
        If Zeile_L < Zei_1 Or (Zeile_L = 1 And Cells(1, Spa_X) = "") Then
            MsgBox "Es sind keine Bausteine mit ""x"" in Spalte " _
                & Chr(Spa_X + 64) & " markiert", _
                vbOKOnly + vbInformation, MsgTitel
            Exit Sub
        End If
    End With
    
    
'Aktive Word-Anwendung setzen - bei Fehler Word öffnen
    Set Word_App = GetObject(, "Word.Application")

    Word_App.Visible = True
    
'Word-Datei setzen - bei Fehler öffnen
    Set Word_Doc = Word_App.Documents(strNameDatei)
        
    Word_App.Documents(strNameDatei).Activate
    
    With wks
'Spalte mit Text-Bausteinen kopieren
        .Columns(Spa_T).Copy .Columns(Spa_C)
        
'Nummerierung bei den zu kopierenden Texten einfügen
        Zaehler = 0
        For Zeile = Zei_1 To Zeile_L
            If UCase(.Cells(Zeile, Spa_X).Text) = "X" Then
                Zaehler = Zaehler + 1
                
                .Cells(Zeile, Spa_C).Value = "Ziel " & Format(Zaehler, "00") & " " _
                        & .Cells(Zeile, Spa_C).Text
            End If
        Next Zeile
        
'gewählte Einträge nach Word kopieren
        For Zeile = Zei_1 To Zeile_L
            If UCase(.Cells(Zeile, Spa_X).Text) = "X" Then
                
                .Cells(Zeile, Spa_C).Copy
                'in Word einfügen

                Word_App.Selection.PasteSpecial Link:=False, DataType:=1, _
                    Placement:=0, DisplayAsIcon:=False ' 1 = wdPasteRTF  0 = wdInLine

                Word_App.Selection.TypeParagraph ' zeilenumbruch einfügen
            
            End If
        Next Zeile
        'X löschen
        .Range(.Cells(Zei_1, Spa_X), .Cells(Zeile_L, Spa_X)).ClearContents
        'Spalte mit zu kopierenden Werten wieder löschen
        .Columns(Spa_C).Delete
    End With
'    Word_App.Activate
    Excel.ActiveWorkbook.Activate

Fehler:
'Fehlerbehandlung
    With Err
        Select Case .Number
        Case 0 'Alles OK
        
        Case 429 'Active-X-Fehler - Word-Anwendung ist nicht geöffnet
            Set Word_App = VBA.CreateObject("Word.Application")
            Resume Next
        Case 4160 'Ungültiger Dateiname - Word-Datei ist nicht geöffnet
            Set Word_Doc = Word_App.Documents.Open(Filename:=strPathDatei & strNameDatei)
            Resume Next
        Case Else
            MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
                    vbCritical + vbOKOnly, "Fehler - " & MsgTitel
        End Select
    End With

End Sub



  

Betrifft: AW: Daten von Excel nach Word von: Inshin
Geschrieben am: 25.05.2017 21:44:26

Hey Franz,
das funktioniert einwandfrei und zudem noch super erklärt.

perfekt....vielen lieben Dank dafür.
Grüße von der Insel
Tom