Thema Datum  Von Nutzer Rating
Antwort
Rot Werte aus Excel Tabelle an Word (Bookmark) übergeben
05.08.2018 16:19:46 Hideki
NotSolved
05.08.2018 17:15:31 Gast32517
NotSolved
05.08.2018 17:18:35 Gast81653
NotSolved
05.08.2018 18:47:08 Hideki
NotSolved
06.08.2018 00:56:33 Gast68861
NotSolved
06.08.2018 14:07:29 Hideki
NotSolved
07.08.2018 03:31:51 Gast90784
NotSolved
08.08.2018 13:37:05 Hideki
NotSolved
08.08.2018 18:21:35 Hideki
NotSolved
08.08.2018 21:28:42 Gast42157
NotSolved
08.08.2018 21:31:24 Gast3319
NotSolved
09.08.2018 13:27:18 Hideki
NotSolved
09.08.2018 14:37:53 Gast87672
NotSolved
09.08.2018 14:56:16 Hideki
NotSolved
09.08.2018 14:58:22 Gast7177
NotSolved
09.08.2018 13:27:23 Hideki
NotSolved

Ansicht des Beitrags:
Von:
Hideki
Datum:
05.08.2018 16:19:46
Views:
1038
Rating: Antwort:
  Ja
Thema:
Werte aus Excel Tabelle an Word (Bookmark) übergeben

Hallo,

ich habe eine Excel-Datei.

In dem erstem Sheet (Name:Alles) gibt es mehrere Zeilen, welche durch ein Makro in den entsprechenden anderen Sheets (Namen:1-10) verteilt werden.

Ich habe im Netz mehrere Codes gefunden welche die ausgewählten Daten in ein Word-Dokument kopieren.

Meine Probleme:

1) Es sollen nur Zeilen mit Inhalt nach Word kopiert werden. Die Anzahl an Zeilen variiert.

2) Die Daten sollen in Word an einen Bookmark-Stelle kopiert werden. Nicht hintereinander weg, sondern untereinander.

3) Jedes Sheet soll in eine separate Bookmark.

Ich habe es hin bekommen, das die Daten untereinander in Word kopiert werden, aber nicht an die Bookmark stelle.

Oder es werden die Daten an die Bookmark-Stelle kopiert, aber nach einander ohne neue Zeile in Word.

Auch kann in  in dem einem Skript nur eine Zeile (Range("A3") angeben. Hier suche ich nach einer Lösung, das die Rangeliste variabel ist.

Jetzt kommen die drei Skripte mit denen es mir zum Teil gelungen ist dies um zusetzen, aber noch nicht die gewollte Lösung enthält.

1tes Makro:

Option Explicit

Public Sub Test()

    Dim strFileName As String

    Dim strTMP1 As String

    Dim strTMP2 As String

    Dim strTMP3 As String

    Dim objWDApp As Object

    Dim objDoc As Object

    On Error GoTo Fin

    strFileName = ThisWorkbook.Path & "\" & "test-doc.docx" 'adapt

    If Dir(strFileName) <> "" Then

        Application.ScreenUpdating = False

        With Sheets("1")

            strTMP1 = .Range("A3")

         '   strTMP2 = .Range("C17")

         '   strTMP3 = .Range("D12")

        End With

        On Error Resume Next

        Set objWDApp = GetObject(, "Word.Application")

        If objWDApp Is Nothing Then Set objWDApp = CreateObject("Word.Application")

        On Error GoTo 0

        With objWDApp

            .Visible = False 'Or True, if Word is to be indicated

            Set objDoc = .Documents.Open(strFileName)

            .ActiveDocument.Bookmarks("Bookmark1").Range = strTMP1

            '.ActiveDocument.Bookmarks("Bookmark2").Range = strTMP2

            '.ActiveDocument.Bookmarks("Bookmark3").Range = strTMP3

        End With

        MsgBox "Finished!"

    Else

        MsgBox "No file!"

    End If

Fin:

    Application.ScreenUpdating = True

    If Not objDoc Is Nothing Then objDoc.Save

    If Not objWDApp Is Nothing Then objWDApp.ActiveDocument.Close: objWDApp.Quit

    Set objWDApp = Nothing

End Sub

2tes Makro:

Public Sub CommandButton5_Click()

Dim AppWord As Word.Application

Set AppWord = CreateObject("Word.Application")

AppWord.Visible = True

With Sheets("1").Range("A:A")

.Offset(0, 0).SpecialCells(xlCellTypeVisible).Copy

End With

'Sheets("1").Range(Cells(1, 1), Cells(7, 1)).Copy

AppWord.Documents.Add

AppWord.Selection.Paste

Application.CutCopyMode = False

Set AppWord = Nothing

End Sub

3tes Makro:

Hier wäre es super, wenn ich irgend die die Bookmarks reinbekommen würde.

Const wdMove = 0        'Word-Konstanten

Const wdLine = 5

Const wdStory = 6

Const InsertLine = 4    'Word-Einfügzeile

Sub nachword()

    Dim DocPath As String

    DocPath = ThisWorkbook.Path & "\" & "test-doc.docx" 'Word-Dokument

    Dim AppWord As Object

    Set AppWord = CreateObject("Word.Application")

    With Sheets("1").Range("A:A")

    .Offset(0, 0).SpecialCells(xlCellTypeVisible).Copy

    End With

    With AppWord

        .Visible = True

        .Documents.Open DocPath

         With .Selection

            .HomeKey Unit:=wdStory, Extend:=wdMove      'Position 1. Zeile setzen

            .MoveDown Unit:=wdLine, Count:=InsertLine   'Position n. Zeilen nach unten

            .Paste

         End With

    End With

    Set AppWord = Nothing

    Application.CutCopyMode = False

End Sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Werte aus Excel Tabelle an Word (Bookmark) übergeben
05.08.2018 16:19:46 Hideki
NotSolved
05.08.2018 17:15:31 Gast32517
NotSolved
05.08.2018 17:18:35 Gast81653
NotSolved
05.08.2018 18:47:08 Hideki
NotSolved
06.08.2018 00:56:33 Gast68861
NotSolved
06.08.2018 14:07:29 Hideki
NotSolved
07.08.2018 03:31:51 Gast90784
NotSolved
08.08.2018 13:37:05 Hideki
NotSolved
08.08.2018 18:21:35 Hideki
NotSolved
08.08.2018 21:28:42 Gast42157
NotSolved
08.08.2018 21:31:24 Gast3319
NotSolved
09.08.2018 13:27:18 Hideki
NotSolved
09.08.2018 14:37:53 Gast87672
NotSolved
09.08.2018 14:56:16 Hideki
NotSolved
09.08.2018 14:58:22 Gast7177
NotSolved
09.08.2018 13:27:23 Hideki
NotSolved