Aus Excel Tabellenbereich in Word anwählen
15.11.2019 14:44:20
Johannes
Ich habe eine VBA geschrieben die folgende Funktionen hat:
Zunächst werden von einem Datum ausgehend die Anzahl der Tage des betreffenden Monats brechnet,
dann dann wird entland einer Zeile nach einem Schagwort gesucht.
Wird das schlagwort gefunden wird eine Word Datei geöffnet, umbennant und gespeichert.
Dann wird entsprechend der Anzahl der Monatstage in einer WordTabelle entsprechend viele Zeilen hinzu addiert und mit einem Datum versehen.
Dann wird in der Exceldatei ein Bereich definiert und kopiert.
Soweit klappt alles
Was es jetzt noch brauch ist dass in der Word datei ein entsprechender Bereich in der Tabelle ausgewähöt wird und die Werte eingefügt werden.
Leider komme ich hier nicht weiter.
kann mir jmd helfen?
P.S. Ich weiß es sind zuviele Variablen definiert :)
Sub datenausexcel_3()
Dim appWord As Word.Application 'Object
Dim wrdDocument As Word.Document 'Object
Dim intZ As Integer, intS As Integer 'Anzahl Zeilen und Spalten
Dim wks As Worksheet
Dim strVorlage As String
Dim strWKB_Name As String
Dim objTbl(1) As Word.Table
Dim NumbVNB As Integer
Dim SpeicherName As String 'Notwendig um es Umzubennen
Dim Speicherpfad As String 'Richtiger Speicherpfad später ergänzen
Dim VNB As String
Dim d As Date
Dim a As Integer
Dim intZ2 As Integer, intS2 As Integer
Dim Zeilanz As Integer
Dim rng As Range
d = ThisWorkbook.Sheets("Prognosegüte (d)").Cells(4, 2).Value
a = Day(DateSerial(Year(d), Month(d) + 1, 0))
On Error GoTo FehlerMarke
strWKB_Name = ActiveWorkbook.Name
Set wks = ActiveWorkbook.Worksheets("Prognosegüte (d)") 'Tabellenblatt mit den zu ü _
bertragenden Daten
Speicherpfad = "Y:\VBA Versuche\"
'Speicherpfad2 = "N:\" & NumbVNB - 2 & Format(DateSerial(Year(Date), _
Month(Date), 0), "YYYY") & "\Reporting"
'SpeicherName = Speicherpfad & Format(DateSerial(Year(Date), Month(Date) _
_
, 0), "YYYY-MM") & " NEB Bericht " & ThisWorkbook.Sheets("Prognosegüte (d)").Cells(1, 7).Value & _
".docx"
For NumbVNB = 1 To 65
'Hier mit If Bedingung beginnen
If Cells(1, NumbVNB).Text = "JA" Then
SpeicherName = Speicherpfad & Format(DateSerial(Year(d), Month(d) + _
_
1, 0), "YYYY-MM") & " NEB Bericht " & ThisWorkbook.Sheets("Prognosegüte (d)").Cells(1, NumbVNB - _
1).Value & ".docx"
Set appWD = CreateObject("Word.Application")
Set wrdDocument = appWD.Documents.Open("Y:\VBA Versuche\NEB-Bericht. _
_
docx")
wrdDocument.SaveAs Filename:=SpeicherName
wrdDocument.Bookmarks("Monat").Range.Text = Format(DateSerial(Year( _
_
d), Month(d) + 1, 0), "MMMM YYYY")
wrdDocument.Bookmarks("Monat2").Range.Text = Format(DateSerial(Year( _
_
d), Month(d) + 1, 0), "MMMM YYYY")
wrdDocument.Bookmarks("VNB").Range.Text = ThisWorkbook.Sheets(" _
Prognosegüte (d)").Cells(1, NumbVNB - 1).Value
wrdDocument.Bookmarks("VNB2").Range.Text = ThisWorkbook.Sheets(" _
Prognosegüte (d)").Cells(1, NumbVNB - 1).Value
appWD.Visible = True 'Nur für die Tests später deaktivieren
For Zeilanz = 0 To a - 1
wrdDocument.Tables(1).Cell(intZ - 4, 1).Range = d + Zeilanz
wrdDocument.Tables(1).Rows.Add
Next Zeilanz
wks.Range(Cells(6, NumbVNB - 2), Cells(a + 5, NumbVNB)).Copy
appWord.Activate
Set rng = wrdDocument.Range
rng.Select.Range Start:=wrdDocument.Tables(1).Cell(2, 2).Range.Start, _
_
End:=wrdDocument.Tables(1).Cell(a + 1, 4).Range.End
wrdDocument.Range.Paste
End If
Next NumbVNB
FehlerMarke:
MsgBox Err.Description
End Sub