|
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:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 | 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"
If Dir(strFileName) <> "" Then
Application.ScreenUpdating = False
With Sheets("1")
strTMP1 = .Range("A3")
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
Set objDoc = .Documents.Open(strFileName)
.ActiveDocument.Bookmarks("Bookmark1").Range = strTMP1
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:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | 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
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.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 | Const wdMove = 0
Const wdLine = 5
Const wdStory = 6
Const InsertLine = 4
Sub nachword()
Dim DocPath As String
DocPath = ThisWorkbook.Path & "\" & "test-doc.docx"
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
.MoveDown Unit:=wdLine, Count:=InsertLine
.Paste
End With
End With
Set AppWord = Nothing
Application.CutCopyMode = False
End Sub
|
|